主题：EXCEL自动更新表

Dim cj2 As WinForm.DateTimePicker = e.Form.Controls("DateTimePicker2")

If cj2.text = Nothing Then

    messagebox.show("请输入日期!")

Else

    Dim y,m,d As Integer

    Dim dt2 As Date

    dt2 = vars("cc")

    Dim dt1 As Date = #1/01/0001#

    DateYMD(dt1,dt2, y, m, d)

    y=y+1

    m=m+1

    d=d+1

    Dim f0 As String = "E:\快盘\fyyw\fydb" & y & "0" & m & ".xls"  '快盘本月单表

    Dim f1 As String = "E:\财务数据汇总\饲料汇总单表\汇总单表附.xls"  '软件本月单表

    Dim f2 As String ="E:\快盘\fyyw\fydb" & y & "0" & m-1 & ".xls"  '快盘上月单表

    Dim f3 As String = "E:\财务数据汇总\饲料汇总单表\上月汇总单表.xls"  '软件上月单表

    Dim f4 As String ="E:\快盘\fyyw\fydb" & y-1 & "0" & m & ".xls"  '快盘上年单表

    Dim f5 As String = "E:\财务数据汇总\饲料汇总单表\上年汇总单表.xls"  '软件上年单表

    Dim f6 As String =  "E:\快盘\fyyw\fyhz" & y & "0" & m & ".xls"  '快盘本月集团汇总

    Dim f7 As String = "E:\财务数据汇总\饲料汇总单表\集团汇总附.xls" '软件本月集团汇总

    Dim f8 As String = "E:\财务数据汇总\饲料汇总单表\汇总单新表.xls" '软件公司新表

    If not FileSys.FileExists(f0) Then

        If FileSys.FileExists(f6) Then

            FileSys.CopyFile(f4,f5,True)

            FileSys.CopyFile(f2,f3,True)

            Dim App As New MSExcel.Application

            Dim Wb As MSExcel.WorkBook = App.WorkBooks.open(f1)

            For Each Ws As MSExcel.WorkSheet In Wb.WorkSheets

                ws.cells(2,2) = cj2.text

                ws.UsedRange.Formula = ws.UsedRange.Formula

            Next

            wb.save

            wb.close

            App.Quit

            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(f8,f1,True)

                messagebox.show("已在快盘生成fydb" & y & "0" & m)

            End If

            If not FileSys.FileExists(f0) Then

                Dim Proc As New Process

                Proc.File = (f1)

                Proc.Start()

            End If

        Else

            messagebox.show("快盘不存在fyhz" & y & "0" & m)

        End If

    Else

        messagebox.show("快盘已存在fydb" & y & "0" & m)

    End If

End If