Dim cj As WinForm.DateTimePicker = e.Form.Controls("DateTimePicker2")
If cj.Text = Nothing Then
messagebox.show("请在导入月终日期输入日期!")
Else
Dim y,m,d1 As Integer
Dim dt2 As Date
dt2 = vars("cc")
Dim dt1 As Date = #1/01/0001#
DateYMD(dt1,dt2, y, m, d1)
y=y+1
m=m+1
d1=d1+1
Dim f0l As String = "E:\快盘\excel" & y & "\汇总单表" & y & "0" & m & ".xls"
If Not FileSys.FileExists(f0l) Then
Dim fl As String = "E:\快盘\excel" & y & "\集团汇总" & y & "0" & m & ".xls"
If Not FileSys.FileExists(fl) Then
Messagebox.Show("请先生成:集团汇总" & y & "0" & m & "","提示")
Else
FileSys.CopyFile("E:\快盘\excel" & y & "\汇总单表" & y & "0" & m-1 & ".xls", ProjectPath & "\汇总单表\上月汇总单表.xls",True)
FileSys.CopyFile("E:\快盘\excel" & y-1 & "\汇总单表" & y-1 & "0" & m & ".xls", ProjectPath & "\汇总单表\上年同期汇总单表.xls",True)
FileSys.CopyFile("E:\快盘\excel" & y & "\集团汇总" & y & "0" & m & ".xls", ProjectPath & "\汇总单表\集团汇总.xls",True)
Dim Book As New XLS.Book(ProjectPath & "汇总单表\汇总单表.xls")
Dim App As New MSExcel.Application
Dim rg1,rg2,rg3,rg4,rg5 As MSExcel.Range
Dim Wb As MSExcel.WorkBook = App.WorkBooks.open(ProjectPath & "汇总单表\汇总单表.xls")
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 Ws7 As MSExcel.WorkSheet = Wb.WorkSheets("工资月报")
Dim Ws8 As MSExcel.WorkSheet = Wb.WorkSheets("茂名快报")
Dim Ws9 As MSExcel.WorkSheet = Wb.WorkSheets("分单位")
Dim Ws10 As MSExcel.WorkSheet = Wb.WorkSheets("资产负债指标表")
Dim Ws11 As MSExcel.WorkSheet = Wb.WorkSheets("利润及相关指标表")
Ws1.cells(4,4) = cj.text
Ws1.cells(7,4) = cj.text
rg1 = Ws3.cells(14,5)
rg2 = Ws3.cells(15,9)
rg3 = Ws4.cells(23,5)
rg4 = Ws4.cells(31,5)
rg5 = Ws5.cells(32,5)
rg1.value = rg1.value - vars("tx1")
rg2.value= rg2.value - vars("tx1")
rg3.value = rg3.value- vars("tx2")
rg4.value= rg4.value- vars("tx2")
rg5.value= rg5.value- vars("tx2")
ws1.UsedRange.Formula = ws1.UsedRange.Formula
ws2.UsedRange.Formula = ws2.UsedRange.Formula
ws3.UsedRange.Formula = ws3.UsedRange.Formula
ws4.UsedRange.Formula = ws4.UsedRange.Formula
ws5.UsedRange.Formula = ws5.UsedRange.Formula
ws6.UsedRange.Formula = ws6.UsedRange.Formula
ws7.UsedRange.Formula = ws7.UsedRange.Formula
ws8.UsedRange.Formula = ws8.UsedRange.Formula
ws9.UsedRange.Formula = ws9.UsedRange.Formula
ws10.UsedRange.Formula = ws10.UsedRange.Formula
ws11.UsedRange.Formula = ws11.UsedRange.Formula
app.displayalerts=False
wb.saveas("E:\快盘\excel" & y & "\汇总单表" & y & "0" & m & ".xls")
wb.close
App.Quit
Dim Proc As New Process
Proc.File = ("E:\快盘\excel" & y & "\汇总单表" & y & "0" & m & ".xls")
Proc.Start()
End If
Else
If MessageBox.Show("是否将链接粘贴回数值,估计每个表要20秒?","确 认",MessageBoxButtons.OKCancel,MessageBoxIcon.Question) =DialogResult.OK Then
Dim App As New MSExcel.Application
Dim Wb As MSExcel.Workbook = App.WorkBooks.open("E:\快盘\excel" & y & "\汇总单表" & y & "0" & m & ".xls")
For Each Ws As MSExcel.WorkSheet In Wb.WorkSheets
Ws.UnProtect
Dim ds() As String = {"'C", "'D", "'E"}
Dim Rg As MSExcel.Range = Ws.UsedRange
Dim ary = rg.Formula
For i As Integer = 1 To Ws.UsedRange.Rows.Count
For j As Integer = 1 To Ws.UsedRange.Columns.Count
For Each d As String In ds
If ary(i,j) > "" AndAlso ary(i,j).Toupper.StartsWith("=" & d) Then
ws.cells(i,j).copy
ws.cells(i,j).PasteSpecial(Paste:=MSExcel.XlPasteType.xlPasteValues, Operation:=MSExcel.XlPasteSpecialOperation.xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False)
End If
Next
Next
Next
Next
Wb.Save
App.Quit
End If
Dim Proc As New Process
Proc.File = ("E:\快盘\excel" & y & "\汇总单表" & y & "0" & m & ".xls")
Proc.Start()
End If
End If