pb控制excel合并某些单元格

来源:互联网 发布:php网站源码 编辑:程序博客网 时间:2024/06/16 15:55

 

合并某些单元格
--------------------------------------------------------------------------------
String docname,named
String current_dir
Integer i,j
String ls_colums[] = {"A","B","C"} //待合并的列
String ls_values[]
String ls_value,ls_range
Long ll_row_prior[]
Long ll_row
Long ll_rowcount = 986 //Excel中的有效行数
Long ll_start_row = 1 //开始行数,2可表示为由标题行
//================================================================================
//选择文件
current_dir = GetCurrentDirectory()
j = GetFileOpenName("文件选择",docname,named,"xls","Excel文档 (*.xls), *.xls")
ChangeDirectory(current_dir)
If j <> 1 Then Return -1

pointer oldpointer
oldpointer = SetPointer(HourGlass!)

//初始化2个数组
For i = 1 To UpperBound(ls_colums)
ls_values[i] = ""
ll_row_prior[i] = 0
Next

//使用ole向excel中倒入数据
OleObject uo_excel,uo_sheel
uo_excel = Create OleObject
uo_sheel = Create OleObject

If uo_excel.ConnectToNewObject("Excel.Application") <> 0 Then //把ole连接到excel
MessageBox('连接到Excel错误','Excel无法连接!请确认是否已经安装了Excel!~r~n或者与管理员联系!',Exclamation!)
Destroy uo_sheel
Destroy uo_excel
Return -1
End If
//================================================================================
//连接上后,对Excel进行操作
Try //try例行例外 控制
uo_excel.Application.DisplayAlerts = False //强制执行,不用提示
uo_excel.Application.Workbooks.Open(docname)
uo_sheel = uo_excel.ActiveSheet() //得到当前工作表

//ll_rowcount = Long(uo_sheel.Selection.Select.rows.count)
For ll_row = ll_start_row To ll_rowcount
For i = 1 To UpperBound(ls_colums)
ls_value = uo_sheel.Range(ls_colums[i] + String(ll_row)).Value
If ll_row = 1 Then
ls_values[i] = ls_value
ll_row_prior[i] = ll_row
Else
If ls_value <> ls_values[i] Then
If ll_row_prior[i] = ll_row - 1 Then
ls_values[i] = ls_value
ll_row_prior[i] = ll_row
Else
ls_range = ls_colums[i] + String(ll_row_prior[i]) + ":" + ls_colums[i] + String(ll_row - 1)
uo_sheel.Range(ls_range).Merge()

ls_values[i] = ls_value
ll_row_prior[i] = ll_row
End If
End If
End If
Next
Next

uo_excel.ActiveWorkbook.Save()
uo_excel.Application.DisplayAlerts = True
Catch(runtimeerror er) //捕获 异常
MessageBox("运行时出错", er.GetMessage(),Exclamation!)
Finally
uo_excel.Application.Quit()
Destroy uo_sheel //注销对象
Destroy uo_excel //注销对象
End Try

SetPointer(oldpointer)

 

//画表格线
s_range = "A2:" + s_colnum + Trim(String(l_rows + 2))
xlsub.range(s_range).borders(1).linestyle = 1
xlsub.range(s_range).borders(2).linestyle = 1
xlsub.range(s_range).borders(3).linestyle = 1
xlsub.range(s_range).borders(4).linestyle = 1

0 0
原创粉丝点击