主题：进度条

Dim c As Date = vars("cc")

Dim y As Integer = c.year

Dim m As Integer = c.month

Dim f0 As String = "生猪报表\报表" & y & Format(m,"00")

If not FileSys.DirectoryExists(ProjectPath & f0) Then

    FileSys.CreateDirectory(f0)

    Dim f1 As String = "模板\基层报表模板.xls"

    For Each file As String In filesys .GetFiles(ProjectPath & "报表1")

        If file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then

            Dim Book1 As New XLS.Book(file)

            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("附列资料")

            Dim Sheet1 As XLS.Sheet = Book1.Sheets("分户快报")

            Dim Sheet2 As XLS.Sheet = Book1.Sheets("资产负债表")

            Dim Sheet3 As XLS.Sheet = Book1.Sheets("利润及分配表")

            Dim Sheet4 As XLS.Sheet = Book1.Sheets("费用表")

            Dim Sheet5 As XLS.Sheet = Book1.Sheets("工资月报")

            Dim Sheet6 As XLS.Sheet = Book1.Sheets("附列资料")

            ws2.cells(4,1).Value = Sheet2(3,0).Value   '单位名称

            ws2.cells(2,1).Value = Sheet2(1,0).Value   '日期

            Dim s As String  = Sheet2(3,0).Value

            Dim tt As Table = Tables("单位")

            Dim i As Integer

            For i1 As Integer = 0 To tt.Rows.Count - 1

                If s.Contains(tt.Rows(i1)("单位1")) Then

                    i = i1

                    s = tt.Rows(i1)("单位2")

                    Exit For

                End If

            Next

            '分户快报

            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

            '资产负债表

            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

            '利润及分配表

            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

            '费用表

            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

            '工资月报

            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

            '附列资料

            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

            Dim f2 As String = f0 & "\" & s & y & Format(m,"00") & ".xls"

            FileSys.DeleteFile(file)

            For Each Ws As MSExcel.WorkSheet In Wb.WorkSheets

                ws.UsedRange.Formula = ws.UsedRange.Formula

                ws.Activate

                app.ActiveWindow.DisplayZeros = False

            Next

            wb.saveas(ProjectPath & f2)

            wb.close

            App.Quit

        End If

    Next

    messagebox.show("已全部另存生成基层报表!")

Else

    messagebox.show("已另存生成生猪报表!")

End If