Dim st As Date = Date.Now '将开始时间保存在变量st中 e.Form.Controls("Label2").Text = "" Dim c As Date = vars("cc") Dim n As Integer = 1 Dim f0 As String = "报表\报表" & Format(c,"yyyyMM") Dim f1 As String = "模板\基层报表模板.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 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") s = s & Format(c,"yyyyMM") Exit For End If Next Dim f2 As String = f0 & "\" & s & Format(c,"yyyyMM") & ".xls" If FileSys.FileExists(f2) Then If MessageBox.Show(s & "公司报表已另存,是否重新另存?","确认",MessageBoxButtons.OKCancel,MessageBoxIcon.Question) =DialogResult.OK Then FileSys.DeleteFile(f2) End If End If If not FileSys.FileExists(f2) Then e.Form.Controls("Label2").Text = "正在另存" & n & "子公司报表,请稍后..." Application.DoEvents() Dim App As New MSExcel.Application Dim wb As MSExcel.WorkBook = App.WorkBooks.open(ProjectPath & f1) Dim ws1 As MSExcel.WorkSheet = wb.WorkSheets("分户快报") Dim ws2 As MSExcel.WorkSheet = wb.WorkSheets("资产负债表") Dim ws3 As MSExcel.WorkSheet = wb.WorkSheets("利润及分配表") Dim ws4 As MSExcel.WorkSheet = wb.WorkSheets("费用表") Dim ws5 As MSExcel.WorkSheet = wb.WorkSheets("工资月报") Dim ws6 As MSExcel.WorkSheet = wb.WorkSheets("附列资料") Dim Sheet1 As XLS.Sheet = Book1.Sheets("分户快报") Dim Sheet3 As XLS.Sheet = Book1.Sheets("利润及分配表") Dim Sheet4 As XLS.Sheet = Book1.Sheets("费用表") Dim Sheet5 As XLS.Sheet = Book1.Sheets("工资月报") Dim Sheet6 As XLS.Sheet = Book1.Sheets("附列资料") ws2.cells(4,1).Value = Sheet2(3,0).Value '单位名称 ws2.cells(2,1).Value = Sheet2(1,0).Value '日期 '分户快报 For n1 As Integer = 3 To 5 For n2 As Integer = 4 To 48 If ws1.cells(n2+1,n1+1).Formula = "" Then ws1.cells(n2+1,n1+1).Value = val(Sheet1(n2,n1).Value) End If Next Next '资产负债表 For n1 As Integer = 2 To 3 For n2 As Integer = 5 To 54 If ws2.cells(n2+1,n1+1).Formula = "" Then ws2.cells(n2+1,n1+1).Value = val(Sheet2(n2,n1).Value) End If If ws2.cells(n2+1,n1+5).Formula = "" 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).Formula = "" Then ws3.cells(n2+1,n1+1).Value = val(Sheet3(n2,n1).Value) End If If ws3.cells(n2+1,n1+5).Formula = "" 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).Formula = "" 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).Formula = "" 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).Formula = "" Then ws6.cells(n2+1,n1+1).Value = val(Sheet6(n2,n1).Value) End If Next Next FileSys.DeleteFile(file) For Each Ws As MSExcel.WorkSheet In Wb.WorkSheets ws1.UsedRange.Formula = ws1.UsedRange.Formula ws1.Activate app.ActiveWindow.DisplayZeros = False Next n = n + 1 wb.saveas(ProjectPath & f2) wb.close App.Quit End If End If Next e.Form.Controls("Label2").Text = "已经完成另存" & n-1 & "子公司!" MessageBox.Show("耗时: " & (Date.Now - st).TotalSeconds & "秒") '计算并显示执行代码所花费的秒数
|