专家坐堂-EXCEL自动更新表Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  EXCEL自动更新表  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=55943)

--  作者：发财
--  发布时间：2014/8/26 15:56:00
--  EXCEL自动更新表

Dim Book As New XLS.Book(ProjectPath & "汇总单表\\汇总单表.xls")
Dim Sheet1 As XLS.Sheet = Book.Sheets("日期")
Dim cj As WinForm.DateTimePicker = e.Form.Controls("DateTimePicker2")
If cj.Text =Nothing Then
messagebox.show("请在导入月终日期输入日期!")
Else
Sheet1(3,3).Value = cj.text
Sheet1(6,3).Value = cj.text
Book.Save(ProjectPath & "汇总单表\\汇总单表1.xls")
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.open(ProjectPath & "汇总单表\\汇总单表1.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.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

wb.save
wb.close
App.Quit

Dim Proc As New Process
Proc.File = (ProjectPath & "汇总单表\\汇总单表1.xls")
Proc.Start()
End If
其中汇总单表链接表外数据，每次打开时都要求自动更新的，因而打开时出现错误报表，并自动添加了一个表ONGRGUT,不知如何修改呢？

--  作者：有点甜
--  发布时间：2014/8/26 16:00:00
--
哪段代码错？vba不是可以控制的么？你就不能全部用vba去做？

--  作者：发财
--  发布时间：2014/8/26 16:28:00
--
全部用vba做就行了。感谢了！

--  作者：发财
--  发布时间：2014/8/27 15:36:00
--

Dim aa1() As String = {"日期","分户快报","资产负债表","利润及分配表","费用表","附列资料","工资月报","茂名快报","分单位","资产负债指标表","利润及相关指标表"}
For i1 As Integer = 1 To 11
Dim Ws(i1) As MSExcel.WorkSheet = Wb.WorkSheets(aa1(i1))
Next
上述代码为什么不行？

--  作者：有点甜
--  发布时间：2014/8/27 15:41:00
--

Dim aa1() As String = {"日期","分户快报","资产负债表","利润及分配表","费用表","附列资料","工资月报","茂名快报","分单位","资产负债指标表","利润及相关指标表"}

For i1 As Integer = 0 To 10

    Dim Ws(i1) As MSExcel.WorkSheet = Wb.WorkSheets(aa1(i1))

Next

--  作者：发财
--  发布时间：2014/8/27 15:43:00
--
还是不行？

--  作者：有点甜
--  发布时间：2014/8/27 15:49:00
--

以下是引用发财在2014-8-27 15:43:00的发言：
还是不行？

例子，代码，全部发上来。

问问题不要说一句没一句的，别人不知道你什么意思

--  作者：发财
--  发布时间：2014/8/27 16:33:00
--

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

--  作者：发财
--  发布时间：2014/8/27 16:35:00
--
1.我想简化ws1至ws11
2.粘贴回数值时出现错误：Overload resolution failed because no accessible \'Chars\' accepts this number of arguments.

--  作者：有点甜
--  发布时间：2014/8/27 16:43:00
--

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 aa1() As String = {"日期","分户快报","资产负债表","利润及分配表","费用表","附列资料","工资月报","茂名快报","分单位","资产负债指标表","利润及相关指标表"}
            Dim Ws(aa1.Length) As MSExcel.WorkSheet
            For i1 As Integer = 1 To 11
                Ws(i1) = Wb.WorkSheets(aa1(i1))
            Next
            ws(1).cells(4,4) = cj.text
            ws(1).cells(7,4) = cj.text
            rg1 = ws(3).cells(14,5)
            rg2 = ws(3).cells(15,9)
            rg3 = ws(4).cells(23,5)
            rg4 = ws(4).cells(31,5)
            rg5 = ws(5).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")

            For i1 As Integer = 1 To 11
                ws(i1).UsedRange.Formula = ws(i1).UsedRange.Formula
            Next
            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