以文本方式查看主题 - 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 = 0 \'设置最小值 p.Value = 0 \'设置当前值 For i As integer = 0 To MainTable.Rows.Count - 1 MainTable.Rows(i)("第一列") = i If i Mod 100 = 0 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 |