以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  EXCEL报表合并问题  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=76693)
--  作者：douglas738888
--  发布时间：2015/11/3 16:19:00
--  EXCEL报表合并问题
前几天所写的测试代码都还可以运行，今天把代码另写入设计文件后，报错，不合并表格，请老师指导指导。谢谢
以下是测试代码文件
 下载信息  [文件大小：   下载次数： ]
图片点击可在新窗口打开查看点击浏览该文件:新建文件夹 (2).zip
--  作者：大红袍
--  发布时间：2015/11/3 16:49:00
--  
请把数据库发上来。
--  作者：douglas738888
--  发布时间：2015/11/3 17:23:00
--  
 下载信息  [文件大小：   下载次数： ]
图片点击可在新窗口打开查看点击浏览该文件:gh.zip
--  作者：大红袍
--  发布时间：2015/11/3 17:28:00
--  

Dim Book1 As New XLS.Book(ProjectPath & "Attachments\\test.xls")
Dim fl As String = ProjectPath & "Reports\\test.xls"
Dim Sheet1 As XLS.Sheet = Book1.Sheets(0)
Dim Sheet2 As XLS.Sheet = Book1.Sheets(1)
Dim Sheet3 As XLS.Sheet = Book1.Sheets(2)
Sheet1(3,8).Value = "<记账日期 = # " & Date.Today & "#>"  \'写入打印条件
Sheet2(3,6).Value = "<记账日期1 = # " & Date.Today & "#>"  \'写入打印条件

Book1.Build() \'生成报表
Book1.Save(fl)


Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)
Dim Ws1 As MSExcel.WorkSheet = Wb.WorkSheets("Sheet1") \'指定要复制的工作表
Dim Ws2 As MSExcel.WorkSheet = Wb.WorkSheets("Sheet2")
Dim Ws3 As MSExcel.WorkSheet = Wb.WorkSheets("Sheet3")
Ws1.UsedRange.Copy
ws3.Cells(1,1).Select
ws3.paste
Ws2.UsedRange.Copy
ws3.Cells(1,Ws1.UsedRange.Columns.Count+2).Select \'横向拷贝
\'ws3.Cells(Ws1.UsedRange.Rows.Count,1).Select \'纵向拷贝
ws3.paste
Wb.Save
app.Visible = True
\'App.Quit
--  作者：douglas738888
--  发布时间：2015/11/3 17:48:00
--  
非常感谢老师的指导！！！
--  作者：douglas738888
--  发布时间：2015/11/4 10:21:00
--  
老师，又要麻烦您了，参照您给的代码写入设计文件，弄了一晚上还是报错，是不是我的EXCEL有问题，还是我的细节区设置有问题，还得请老师再帮忙看看。
问题：1.报错RANG选择方法有错   2.点击代码按钮，EXCEL老是报已打开。

下面是从设计文件中导出的测试文件
 下载信息  [文件大小：   下载次数： ]
图片点击可在新窗口打开查看点击浏览该文件:测试.zip
--  作者：大红袍
--  发布时间：2015/11/4 10:40:00
--  

Dim Book1 As New XLS.Book(ProjectPath & "Attachments\\test.xls")
Dim fl As String = ProjectPath & "Reports\\test.xls"

 

Dim App As New MSExcel.Application
try
    Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)
    Dim Ws1 As MSExcel.WorkSheet = Wb.WorkSheets("Sheet1") \'指定要复制的工作表
    Dim Ws2 As MSExcel.WorkSheet = Wb.WorkSheets("Sheet2")
    Dim Ws3 As MSExcel.WorkSheet = Wb.WorkSheets("Sheet3")
    Ws1.UsedRange.Copy
    ws3.activate
    ws3.Cells(1,1).Select
    ws3.paste
    Ws2.UsedRange.Copy
    ws3.activate
    ws3.Cells(1,Ws1.UsedRange.Columns.Count+2).Select \'横向拷贝
    \'ws3.Cells(Ws1.UsedRange.Rows.Count,1).Select \'纵向拷贝
    ws3.paste
    Wb.Save
    app.Visible = True
catch ex As exception
    msgbox(ex.message)
    App.Quit
End try