主题：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

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

                ws11.UsedRange.Formula = ws11.UsedRange.Formula

            Next

为什么不行？