Dim c As Date = vars("cc")
Dim i As Integer
Dim f1 As String = "E:\快盘\excel" & c.year & "\集团汇总" & c.year & Format(c.month,"00") & ".xls"
For Each file As String In filesys .GetFiles(ProjectPath & "报表1")
If file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then
Dim Book1 As New XLS.Book(file)
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.open(f1)
Dim Ws1 As MSExcel.WorkSheet = Wb.WorkSheets("分户快报")
Dim Sheet1 As XLS.Sheet = Book1.Sheets("分户快报")
Dim Ws2 As MSExcel.WorkSheet = Wb.WorkSheets("资产负债表")
Dim Sheet2 As XLS.Sheet = Book1.Sheets("资产负债表")
Dim Ws3 As MSExcel.WorkSheet = Wb.WorkSheets("利润及分配表")
Dim Sheet3 As XLS.Sheet = Book1.Sheets("利润及分配表")
Dim Ws4 As MSExcel.WorkSheet = Wb.WorkSheets("费用表")
Dim Sheet4 As XLS.Sheet = Book1.Sheets("费用表")
Dim Ws5 As MSExcel.WorkSheet = Wb.WorkSheets("工资月报")
Dim Sheet5 As XLS.Sheet = Book1.Sheets("工资月报")
Dim Ws6 As MSExcel.WorkSheet = Wb.WorkSheets("附列资料")
Dim Sheet6 As XLS.Sheet = Book1.Sheets("附列资料")
Dim s1 As String = Sheet1(2,1).Value
If Isdate(Sheet1(1,1).value) = False OrElse Sheet1(1,1).value <> vars("cc") Then
MessageBox.Show(s1 & "导入报表日期不正确!")
wb.close
App.Quit
Return
Else
Dim tt As Table = Tables("单位")
For i1 As Integer = 0 To tt.Rows.Count - 1
If s1.Contains(tt.Rows(i1)("单位1")) Then
i = i1
ws1.cells(i+6,2).Value = tt.Rows(i)("单位2")
Exit For
Else
messagebox.show(s1 & "单位名称不存在!")
wb.close
App.Quit
Return
End If
Next
For n As Integer = 27 To 48 '分户快报
If ws1.cells(i+6,n-1).Formula = "" Then
ws1.cells(i+6,n-1).Value = val(Sheet1(n,3).Value)
End If
Next
For n1 As Integer = 2 To 3
For n2 As Integer = 5 To 54
If ws2.cells(n2+1,n1+1).Value = "" Then
ws2.cells(n2+1,n1+1).Value = val(Sheet2(n2,n1).Value)
End If
If ws2.cells(n2+1,n1+5).Value = "" Then
ws2.cells(n2+1,n1+5).Value = val(Sheet2(n2,n1+4).Value)
End If
Next
Next
For n1 As Integer = 2 To 3
For n2 As Integer = 6 To 35
If ws3.cells(n2+1,n1+1).Value = "" Then
ws3.cells(n2+1,n1+1).Value = val(Sheet3(n2,n1).Value)
End If
If ws3.cells(n2+1,n1+5).Value = "" Then
ws3.cells(n2+1,n1+5).Value = val(Sheet3(n2,n1+4).Value)
End If
Next
Next
For n1 As Integer = 3 To 6
For n2 As Integer = 4 To 32
If ws4.cells(n2+1,n1+1).Value = "" Then
ws4.cells(n2+1,n1+1).Value = val(Sheet4(n2,n1).Value)
End If
Next
Next
For n1 As Integer = 3 To 4
For n2 As Integer = 4 To 24
If ws5.cells(n2+1,n1+1).Value = "" Then
ws5.cells(n2+1,n1+1).Value = val(Sheet5(n2,n1).Value)
End If
Next
Next
For n1 As Integer = 1 To 13
For n2 As Integer = 2 To 19
If ws6.cells(n2+1,n1+1).Value = "" Then
ws6.cells(n2+1,n1+1).Value = val(Sheet6(n2,n1).Value)
End If
Next
Next
For Each Ws As MSExcel.WorkSheet In Wb.WorkSheets
ws.UsedRange.Formula = ws.UsedRange.Formula
ws.Activate
Next
app.ActiveWindow.DisplayZeros = False
wb.save
wb.close
App.Quit
End If
End If
Next
加好友 
发短信
Post By：2015/4/14 8:47:00 [显示全部帖子]
