Dim Book1 As New XLS.Book(ProjectPath & "Attachments\财务收支年报表1.xls")
Dim fl As String = ProjectPath & "Reports\财务收支年报表1.xls"
Dim y As Integer = Date.Today.Year
Dim dt1 As New Date(y, 1, 1)
Dim dt2 As New Date(y, 12, 31)
Dim Filter As String
Filter = "<记账日期 >= #" & dt1 & "# And 记账日期 <= #" & dt2 & "#>"
Dim y1 As Integer = Date.Today.Year
Dim dt11 As New Date(y1, 1, 1)
Dim dt22 As New Date(y1, 12, 31)
Dim Filter1 As String
Filter1 = "<出款日期 >= #" & dt11 & "# And 出款日期 <= #" & dt22 & "#>"
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(5,12).Value = filter '写入打印条件
Sheet2(4,12).Value = filter1 '写入打印条件
Book1.Build() '生成报表
Book1.Save(fl)
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")
Dim Rg As MSExcel.Range = Ws3.Range("A1:A100") '可指定任意单元格或单元格区域
'Rg.RowHeight = 40 '行高40磅
Rg.ColumnWidth = 17 '列宽20磅
Dim Rg1 As MSExcel.Range = Ws3.Range("B1:B100") '可指定任意单元格或单元格区域
'Rg.RowHeight = 40 '行高40磅
Rg1.ColumnWidth = 13 '列宽20磅
Dim Rg2 As MSExcel.Range = Ws3.Range("C1:C100") '可指定任意单元格或单元格区域
'Rg.RowHeight = 40 '行高40磅
Rg2.ColumnWidth = 12 '列宽20磅
Dim Rg3 As MSExcel.Range = Ws3.Range("D1:D100") '可指定任意单元格或单元格区域
'Rg.RowHeight = 40 '行高40磅
Rg3.ColumnWidth = 11 '列宽20磅
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, 1).Select '纵向拷贝
ws3.paste
Wb.Save
'app.Visible = True
catch ex As exception
msgbox(ex.message)
App.Quit
End try
e.Form.Controls("WebBrowser1").AddRess = fl
加好友 
发短信
Post By：2015/11/12 11:35:00 [只看该作者]
