下面的函数f_excel_hb,可以实现“将工作簿filename_s中的工作表sheetname_s以新的工作表名称sheetname_t,复制到工作簿filename_t的最后”
- public function boolean f_excel_hb (string filename_s, string filename_t, string sheetname_s, string sheetname_t);
- //==========================================================
- // 合并两个工作簿中的某个工作表
- //==========================================================
- // 作者:yyoinge 2011-10-12 18:00
- //==========================================================
- // 将工作簿filename_s中的工作表sheetname_s以新的
- // 工作表名称sheetname_t,复制到工作簿filename_t的最后
- //==========================================================
- if not fileexists(filename_s) then
- messagebox('','工作簿【' + filename_s + '】(源)不存在')
- return false
- end if
- if not fileexists(filename_t) then
- messagebox('','工作簿【' + filename_t + '】(目标)不存在')
- return false
- end if
- long ll_val
- //声明ole对象
- oleobject ole_object_s
- //创建ole对象
- ole_object_s=create oleobject
- //连接到excel
- ll_val = ole_object_s.connecttonewobject("excel.application")
- if ll_val <> 0 then
- messagebox('','ole无法连接Excel!')
- goto error
- end if
- //打开源和目标工作簿
- ole_object_s.workbooks.open(filename_s)
- ole_object_s.workbooks.open(filename_t)
- string ls_t
- ls_t = filename_t
- filename_s = of_splitpath(filename_s, 2)
- filename_t = of_splitpath(filename_t, 2)
- //隐藏excel
- ole_object_s.visible = false
- ole_object_s.displayalerts = false
- int n,t
- int li
- boolean isexists=false
- oleobject lworksheet
- //判断源工作簿中的工作表是否存在
- try
- lworksheet = ole_object_s.Workbooks(filename_s).sheets(sheetname_s)
- isexists = true
- catch( oleruntimeerror er)
- isexists = false
- end try
- if isexists=false then
- messagebox('','工作簿【' + filename_s + '】中工作表不存在工作表[' + sheetname_s + ']')
- goto error
- end if
- //当目标工作簿中存在sheet名为sheetname_t的工作表时,为sheetname_t增加后缀(1),然后再重复进行判断,直到表名不存在
- isexists = true
- do while isexists
- try
- lworksheet = ole_object_s.Workbooks(filename_t).sheets(sheetname_t)
- isexists = true
- sheetname_t += '(1)'
- catch( oleruntimeerror er1)
- isexists = false
- end try
- loop
- //进行工作表合并(移到目标工作簿的最后)
- //int li
- setnull(li)
- ole_object_s.workbooks(filename_s).Sheets(sheetname_s).copy(li, ole_object_s.workbooks(filename_t).Sheets(long(ole_object_s.workbooks(filename_t).Sheets.count)))
- //重命名工作表
- ole_object_s.workbooks(filename_t).sheets(long(ole_object_s.workbooks(filename_t).Sheets.count)).name = sheetname_t
- //保存目标工作簿
- isexists = true
- //ole_object_s.visible = true
- //ole_object_s.displayalerts = true
- //messagebox('', '')
- try
- ole_object_s.workbooks(filename_t).save()
- catch( oleruntimeerror er2)
- messagebox('提示', '无法保存工作簿【' + filename_t + '】')
- isexists = false
- end try
- if not isexists then goto error
- //关闭工作簿
- ole_object_s.workbooks(filename_s).close
- ole_object_s.workbooks(filename_t).close
- //退出excel
- ole_object_s.workbooks.close
- ole_object_s.Application.quit();
- //断开连接
- ole_object_s.disconnectobject();
- //注销ole对象
- destroy ole_object_s;
- return true
- error:
- ole_object_s.workbooks(filename_s).close
- ole_object_s.workbooks(filename_t).close
- ole_object_s.workbooks.close
- ole_object_s.Application.quit();
- ole_object_s.disconnectobject();
- destroy ole_object_s;
- return false
- end function
其中用到的一个路径分割函数of_splitpath如下:
- public function string of_splitpath (string as, integer ai);//==========================================================
- // 分割文件名
- // ai: 1返回路径,2返回文件名(带后缀名),32返回文件名(不带后缀名)
- //==========================================================
- // 作者:yyoinge 2011-10-12 18:00
- //==========================================================
- choose case ai
- case 1
- if posw(as, '.') = 0 then return as
- return leftw(as,lenw(as) - posw(reverse(as), '\') + 1)
- case 2
- if posw(as, '\') = 0 then return as
- return rightw(as,posw(reverse(as), '\') - 1)
- case 3
- if posw(as, '\') > 0 then as = rightw(as,posw(reverse(as), '\') - 1)
- return leftw(as, lastpos(as, '.') - 1)
- case else
- return as
- end choose
- end function
pb复制excel工作表的功能,可以帮助我们实现:将1个数据窗口导出到1个excel工作簿的多个工作表sheet中。实现的步骤大致如下:
(1)将datawindow的数据,按照平均行数(每个sheet中需要保存的行数),依次复制到临时的datastore中。如:将1个有10行数据的datawindow,导出为每个sheet包含3行数据的多sheet工作簿,则需要依次将1-3行、4-6行、7-9行、10至10行分别复制到临时的datastore中。
(2)然后将datastore中的数据saveas导出为单个单sheet的excel文件。
(3)将第2次开始导出的excel文件(也就是上述例子中的4-6行开始的excel文件),依次合并到第1次导出的excel文件(1-3行)中,并删除导出的excel文件(1-3行对应的文件暂时不删除)。
(4)待所有数据都导出,并复制到第1次导出的excel文件后,将第1次导出的excel文件改名并复制目标导出路径上,然后删除第1次导出的excel文件。
具体源码可以参照 PB9将数据窗口导出到一个EXCEL文件的多个工作表中 。
该源码使用的是从后到前的导出方法,也就是先导出10-10行,然后导出7-9行。。。最后导出1-3行,因为在该源码中,复制工作表时使用的方法是:
- ole_object_s.workbooks(filename_s).Sheets(sheetname_s).copy(ole_object_s.workbooks(filename_t).Sheets(1) //将源工作表复制到目标工作簿的第1个工作表前面
而上述函数复制工作表的方法为:
- int li
- setnull(li)
- ole_object_s.workbooks(filename_s).Sheets(sheetname_s).copy(li, ole_object_s.workbooks(filename_t).Sheets(long(ole_object_s.workbooks(filename_t).Sheets.count))) //将源工作表复制到目标工作簿的最后1个工作表后面
这边需要对copy方法进行说明,在VBA中,工作表复制的写法为:
- Sheets("工作表名称").Copy Before := Sheets(1) //将工作表“工作表名称”复制到第1个工作表前面
- Sheets("工作表名称").Copy After := Sheets(1) //将工作表“工作表名称”复制到第1个工作表后面
而在pb中对应的写法为:
- int li setnull(li)
- Sheets("工作表名称").Copy(Sheets(1), li) //将工作表“工作表名称”复制到第1个工作表前面
- Sheets("工作表名称").Copy(li, Sheets(1)) //将工作表“工作表名称”复制到第1个工作表后面
- <div style="TOP: 1694px"><pre class="cpp" style="MARGIN: 4px 0px; BACKGROUND-COLOR: rgb(240,240,240)" name="code"><pre>