pb9实现在两个工作簿之间进行工作表复制

来源：互联网发布：美国电视直播软件编辑：程序博客网时间：2024/05/17 01:05

下面的函数f_excel_hb，可以实现“将工作簿filename_s中的工作表sheetname_s以新的工作表名称sheetname_t，复制到工作簿filename_t的最后”

[cpp] view plaincopy
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如下：

[cpp] view plaincopy
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行，因为在该源码中，复制工作表时使用的方法是：

[cpp] view plaincopy
ole_object_s.workbooks(filename_s).Sheets(sheetname_s).copy(ole_object_s.workbooks(filename_t).Sheets(1) //将源工作表复制到目标工作簿的第1个工作表前面  

而上述函数复制工作表的方法为：

[cpp] view plaincopy
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中，工作表复制的写法为：

[cpp] view plaincopy
Sheets("工作表名称").Copy Before := Sheets(1) //将工作表“工作表名称”复制到第1个工作表前面  
Sheets("工作表名称").Copy After := Sheets(1)  //将工作表“工作表名称”复制到第1个工作表后面  

而在pb中对应的写法为：

[cpp] view plaincopy
int li setnull(li)  
Sheets("工作表名称").Copy(Sheets(1), li) //将工作表“工作表名称”复制到第1个工作表前面  
Sheets("工作表名称").Copy(li, Sheets(1)) //将工作表“工作表名称”复制到第1个工作表后面  

[cpp] view plaincopy
<div style="TOP: 1694px"><pre class="cpp" style="MARGIN: 4px 0px; BACKGROUND-COLOR: rgb(240,240,240)" name="code"><pre>  

http://blog.csdn.net/yyoinge/article/details/6942254