以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  内部函数代码出错  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=69672)
--  作者：发财
--  发布时间：2015/6/9 10:15:00
--  内部函数代码出错
Dim d As Date = Args(0)
Dim f1 As String = args(1)
Dim file As String = args(2)
If file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then
    Dim Book1 As New XLS.Book(file)
    Dim str As String
    For Each Sheet As XLS.Sheet In Book1.Sheets
        str = str + Sheet.name + ","
    Next
    Dim Sheet2 As XLS.Sheet = Book1.Sheets("资产负债表")
    Dim s As String  = Sheet2(3,0).Value
    s = s.SubString(s.Length - 6)
    s = s.Substring(0,2)
    s = s & Format(d,"yyyyMM") & ".xls"
    Dim App As New MSExcel.Application
    Dim wb As MSExcel.WorkBook = App.WorkBooks.open(ProjectPath & f1)
    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("附列资料")
    ws2.cells(4,1).Value = Sheet2(3,0).Value   \'单位名称
    ws2.cells(2,1).Value = Sheet2(1,0).Value   \'日期
    If str.Contains("分户快报") Then
        Dim Sheet1 As XLS.Sheet = Book1.Sheets("分户快报")
        For n1 As Integer = 3 To 5
            For n2 As Integer = 4 To 48
                If ws1.cells(n2+1,n1+1).Formula = "" Then
                    ws1.cells(n2+1,n1+1).Value = val(Sheet1(n2,n1).Value)
                End If
            Next
        Next
    Else
        app.DisplayAlerts = False
        ws1.delete
    End If
    If str.Contains("资产负债表") Then
        For n1 As Integer = 2 To 3
            For n2 As Integer = 5 To 54
                If ws2.cells(n2+1,n1+1).Formula = "" Then
                    ws2.cells(n2+1,n1+1).Value = val(Sheet2(n2,n1).Value)
                End If
                If ws2.cells(n2+1,n1+5).Formula = "" Then
                    ws2.cells(n2+1,n1+5).Value = val(Sheet2(n2,n1+4).Value)
                End If
            Next
        Next
    Else
        app.DisplayAlerts = False
        ws2.delete
    End If
    If str.Contains("利润及分配表") Then
        Dim Sheet3 As XLS.Sheet = Book1.Sheets("利润及分配表")
        For n1 As Integer = 2 To 3
            For n2 As Integer = 6 To 35
                If ws3.cells(n2+1,n1+1).Formula = "" Then
                    ws3.cells(n2+1,n1+1).Value = val(Sheet3(n2,n1).Value)
                End If
                If ws3.cells(n2+1,n1+5).Formula = "" Then
                    ws3.cells(n2+1,n1+5).Value = val(Sheet3(n2,n1+4).Value)
                End If
            Next
        Next
    Else
        app.DisplayAlerts = False
        ws3.delete
    End If
    If str.Contains("费用表") Then
        Dim Sheet4 As XLS.Sheet = Book1.Sheets("费用表")
        For n1 As Integer = 3 To 6
            For n2 As Integer = 4 To 32
                If ws4.cells(n2+1,n1+1).Formula = "" Then
                    ws4.cells(n2+1,n1+1).Value = val(Sheet4(n2,n1).Value)
                End If
            Next
        Next
    Else
        app.DisplayAlerts = False
        ws4.delete
    End If
    If str.Contains("工资月报") Then
        Dim Sheet5 As XLS.Sheet = Book1.Sheets("工资月报")
        For n1 As Integer = 3 To 4
            For n2 As Integer = 4 To 24
                If ws5.cells(n2+1,n1+1).Formula = "" Then
                    ws5.cells(n2+1,n1+1).Value = val(Sheet5(n2,n1).Value)
                End If
            Next
        Next
    Else
        app.DisplayAlerts = False
        ws5.delete
    End If
    If str.Contains("附列资料") Then
        Dim Sheet6 As XLS.Sheet = Book1.Sheets("附列资料")
        For n1 As Integer = 1 To 13
            For n2 As Integer = 2 To 19
                If ws6.cells(n2+1,n1+1).Formula = "" Then
                    ws6.cells(n2+1,n1+1).Value = val(Sheet6(n2,n1).Value)
                End If
            Next
        Next
    Else
        app.DisplayAlerts = False
        Wb.WorkSheets("附列资料附表").delete
        ws6.delete
    End If
    For Each Ws As MSExcel.WorkSheet In Wb.WorkSheets
        ws.UsedRange.Formula = ws.UsedRange.Formula
        ws.Activate
        app.ActiveWindow.DisplayZeros = False
    Next
    FileSys.RenameFile(file, s)
    wb.save
    wb.close
    App.Quit
End If
--  作者：大红袍
--  发布时间：2015/6/9 10:16:00
--  

 报什么错？你问问题，能不能说清楚。能不能做一个可以测试例子上来测试？

[此贴子已经被作者于2015/6/9 10:16:46编辑过]
--  作者：发财
--  发布时间：2015/6/9 10:16:00
--  
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("附列资料")
内部函数为什么不能这样?
--  作者：大红袍
--  发布时间：2015/6/9 10:18:00
--  
以下是引用发财在2015/6/9 10:16:00的发言：
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("附列资料")
内部函数为什么不能这样?

 

如果报错，说明你没有对应的表
--  作者：狐狸爸爸
--  发布时间：2015/6/9 10:29:00
--  

楼主，你提问最好不要那么敷衍，既然报错，最少也得将错误提示告诉大家。

一大段代码贴出了，就说不行，没有任何说明，你让别人如何分析？

 

 

另外可以看看：

http://www.foxtable.com/help/topics/1485.htm

这样遇到错误，可以自己先分析定位一下。
--  作者：发财
--  发布时间：2015/6/9 11:22:00
--  
对不起!是报表模板出错了.
--  作者：发财
--  发布时间：2015/6/9 15:56:00
--  

FileSys.RenameFile(file, s)         重命名

wb.saveas(file)                        另存为重命名
wb.close
App.Quit

另存为重命名如何保存为文件名为s,代码wb.saveas(file)应如何修改?
--  作者：大红袍
--  发布时间：2015/6/9 16:02:00
--  

 你问的都不知道是些什么问题

 

wb.saveas(s)     

 
--  作者：发财
--  发布时间：2015/6/9 16:12:00
--  
s 没有路径的?
--  作者：大红袍
--  发布时间：2015/6/9 17:01:00
--  
wb.SaveAs(FileSys.GetParentPath(file) & "\\" & s)