以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  进度条  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=66829)

--  作者:发财
--  发布时间:2015/4/14 16:16:00
--  进度条
Dim p As WinForm.ProgressBar
p = e.Form.Controls(
"ProgressBar1")
p.Maximum = 
MainTable.Rows.Count \'设置最大值
p.Minimum = 
\'设置最小值
p.Value = 
\'设置当前值
For
 i As integer = 0 To MainTable.Rows.Count - 1
    
MainTable.Rows(i)("第一列") = i 
    
If i Mod 100 = Then
        p.Value = i 
\'当前值为已经完成的行数
    
End 
If
Next
进度条如何用在一个文件夹内,将表内每一个EXCEL表复制到另一个表中。用在下述代码中:
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

--  作者:Bin
--  发布时间:2015/4/14 16:19:00
--  
http://www.foxtable.com/help/topics/1476.htm