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

分类： PB技巧 datawindow技巧 ole/com相关2011-11-07
10:03 347人阅读 评论(1) 收藏 举报

下面的函数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></pre>

<pre></pre>

<div></div>

<pre></pre>

<pre></pre>

<div></div>

<pre></pre>

<pre></pre>

<div></div>

<pre></pre>

<pre></pre>

<div></div>

<pre></pre>

</pre></div>

<div class="share_buttons" id="sharePanel"><span>分享到：</span> <a name="sina" class="share_sina" title="分享到新浪微博"></a><a name="qq" class="share_qq" title="分享到腾讯微博"></a></div>

<!--192.168.1.236-->

<div class="article_next_prev">

<li class="prev_article"><span>上一篇：</span><a href="/yyoinge/article/details/6936598">与MSSQL的dateadd函数功能一致的pb加强版时间函数：f_dateadd</a></li>

<li class="next_article"><span>下一篇：</span><a href="/yyoinge/article/details/7267592">PB9写的一个拆解SQL语句的通用函数</a></li>

</div>

<div id="digg" articleid="6942254">

<dl id="btnDigg" class="digg digg_enable">

<dt>顶</dt>

<dd>3</dd>

</dl>

<dl id="btnBury" class="digg digg_enable">

<dt>踩</dt>

<dd>0</dd>

</dl>

</div>