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 f0 As String = "E:\快盘\gs\公司" & y & "0" & m & ".xls" '快盘本月公司
Dim f1 As String = "E:\财务数据汇总\gs\公司.xls" '软件本月公司
Dim f2 As String = "E:\快盘\gs\公司" & y & "0" & m-1 & ".xls" '快盘上月公司
Dim f3 As String = "E:\财务数据汇总\gs\上月公司.xls" '软件上月公司
Dim f4 As String = "E:\快盘\excel" & y & "\集团汇总" & y & "0" & m & ".xls" '快盘本月集团汇总
Dim f5 As String = "E:\财务数据汇总\gs\本月集团汇总.xls" '软件本月集团汇总
Dim f6 As String = "E:\财务数据汇总\gs\公司新表.xls" '软件公司新表
If not FileSys.FileExists(f0) Then
If FileSys.FileExists(f4) Then
FileSys.CopyFile(f4,f5,True)
Else
FileSys.CopyFile(f2,f3,True)
Dim App As New MSExcel.Application
app.AskToUpdateLinks = False '关闭程序询问更新链接提示
app.DisplayAlerts = False
Dim Wb As MSExcel.WorkBook = App.WorkBooks.open(f1)
Dim Ws As MSExcel.WorkSheet
Ws = Wb.WorkSheets("日期")
ws.cells(5,5) = cj.text
For Each Ws11 As MSExcel.WorkSheet In Wb.WorkSheets
ws11.UsedRange.Formula = ws11.UsedRange.Formula
Next
Wb.Save
wb.close
App.Quit
If FileSys.FileExists(f4) Then
If MessageBox.Show("是否将链接粘贴回数值,估计每个表要20秒?","确 认",MessageBoxButtons.OKCancel,MessageBoxIcon.Question) =DialogResult.OK Then
Dim App1 As New MSExcel.Application
Dim Wb1 As MSExcel.Workbook = App1.WorkBooks.open(f1)
For Each Ws1 As MSExcel.WorkSheet In Wb1.WorkSheets
Ws1.UnProtect
Dim Rg As MSExcel.Range = Ws1.UsedRange
rg.Copy
rg.PasteSpecial(Paste:=MSExcel.XlPasteType.xlPasteValues, Operation:=MSExcel.XlPasteSpecialOperation.xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False)
Next
wb1.save
wb1.close
App1.Quit
FileSys.CopyFile(f1,f0,True)
FileSys.CopyFile(f6,f1,True)
messagebox.show("已在快盘生成公司" & y & "0" & m)
End If
End If
End If
If not FileSys.FileExists(f0) Then
Dim Proc As New Process
Proc.File = (f1)
Proc.Start()
End If
Else
messagebox.show("快盘已存在公司" & y & "0" & m)
End If
End If