Dim c As Date = vars("cc")
Dim y As Integer = c.year
Dim m As Integer = c.month
Dim n As Integer = 1
Dim f0 As String = "E:\快盘\另存报表" '存放地址
Dim f1 As String = "E:\财务数据汇总\模板\基层报表模板.xls" '选择模板
Dim f2 As String = e.Form.Controls("Label4").Text '选择报表
Dim Book1 As New XLS.Book(f2)
Dim Sheet2 As XLS.Sheet = Book1.Sheets("资产负债表")
Dim s As String = Sheet2(3,0).Value
Dim tt As Table = Tables("单位")
For i1 As Integer = 0 To tt.Rows.Count - 1
If s.Contains(tt.Rows(i1)("单位1")) Then
s = tt.Rows(i1)("单位2")
Exit For
End If
Next
Dim f3 As String = f0 & "\" & s & y & Format(m,"00") & ".xls"
messagebox.show(f3)
If FileSys.FileExists(f3) Then
If MessageBox.Show(s & "公司报表已另存,是否重新另存?","确认",MessageBoxButtons.OKCancel,MessageBoxIcon.Question) =DialogResult.OK Then
FileSys.DeleteFile(f3)
End If
End If
If not FileSys.FileExists(f3) Then
Dim str As String
Dim App1 As New MSExcel.Application
Dim wb1 As MSExcel.WorkBook = App1.WorkBooks.open(f2)
For Each Ws As MSExcel.WorkSheet In Wb1.WorkSheets '
str = str + ws.name + ","
Next
wb1.close
App1.Quit
Dim App As New MSExcel.Application
Dim wb As MSExcel.WorkBook = App.WorkBooks.open(f1)
For Each Ws As MSExcel.WorkSheet In Wb.WorkSheets '
If ws.name = "分户快报" Then
If str.Contains("分户快报") Then
Dim Sheet1 As XLS.Sheet = Book1.Sheets("分户快报")
For n1 As Integer = 3 To 5
For n2 As Integer = 4 To 48
If ws.cells(n2+1,n1+1).Formula = "" Then
ws.cells(n2+1,n1+1).Value = val(Sheet1(n2,n1).Value)
End If
Next
Next
Else
ws.delete
End If
End If
If ws.name = "资产负债表" Then
If str.Contains("资产负债表") Then
ws.cells(4,1).Value = Sheet2(3,0).Value '单位名称
ws.cells(2,1).Value = Sheet2(1,0).Value '日期
For n1 As Integer = 2 To 3
For n2 As Integer = 5 To 54
If ws.cells(n2+1,n1+1).Formula = "" Then
ws.cells(n2+1,n1+1).Value = val(Sheet2(n2,n1).Value)
End If
If ws.cells(n2+1,n1+5).Formula = "" Then
ws.cells(n2+1,n1+5).Value = val(Sheet2(n2,n1+4).Value)
End If
Next
Next
Else
ws.delete
End If
End If
If ws.name = "利润及分配表" Then
If str.Contains("利润及分配表") Then
Dim Sheet3 As XLS.Sheet = Book1.Sheets("利润及分配表")
For n1 As Integer = 2 To 3
For n2 As Integer = 6 To 35
If ws.cells(n2+1,n1+1).Formula = "" Then
ws.cells(n2+1,n1+1).Value = val(Sheet3(n2,n1).Value)
End If
If ws.cells(n2+1,n1+5).Formula = "" Then
ws.cells(n2+1,n1+5).Value = val(Sheet3(n2,n1+4).Value)
End If
Next
Next
Else
ws.delete
End If
End If
If ws.name = "费用表" Then
If str.Contains("费用表") Then
Dim Sheet4 As XLS.Sheet = Book1.Sheets("费用表")
For n1 As Integer = 3 To 6
For n2 As Integer = 4 To 32
If ws.cells(n2+1,n1+1).Formula = "" Then
ws.cells(n2+1,n1+1).Value = val(Sheet4(n2,n1).Value)
End If
Next
Next
Else
ws.delete
End If
End If
If ws.name = "工资月报" Then
If str.Contains("工资月报") Then
Dim Sheet5 As XLS.Sheet = Book1.Sheets("工资月报")
For n1 As Integer = 3 To 4
For n2 As Integer = 4 To 24
If ws.cells(n2+1,n1+1).Formula = "" Then
ws.cells(n2+1,n1+1).Value = val(Sheet5(n2,n1).Value)
End If
Next
Next
Else
ws.delete
End If
End If
If ws.name = "附列资料" Then
If str.Contains("附列资料") Then
Dim Sheet6 As XLS.Sheet = Book1.Sheets("附列资料")
For n1 As Integer = 1 To 13
For n2 As Integer = 2 To 19
If ws.cells(n2+1,n1+1).Formula = "" Then
ws.cells(n2+1,n1+1).Value = val(Sheet6(n2,n1).Value)
End If
Next
Next
Else
ws.delete
End If
End If
Next
FileSys.DeleteFile(f2)
For Each Ws As MSExcel.WorkSheet In Wb.WorkSheets
ws.UsedRange.Formula = ws.UsedRange.Formula
ws.Activate
app.ActiveWindow.DisplayZeros = False
Next
wb.saveas(f3)
wb.close
App.Quit
messagebox.show("另存报表成功!")
End If
加好友 
发短信
Post By：2015/4/27 16:49:00 [只看该作者]
