[英]How to combine my vba working with a progress bar?
I want to reference to this progress bar sample . 我想参考这个进度条示例。 http://spreadsheetpage.com/index.php/tip/displaying_a_progress_indicator/
http://spreadsheetpage.com/index.php/tip/displaying_a_progress_indicator/
About my vb working ,I m going to generate a report that using ADO in entire worksheet . 关于我的vb工作,我将生成一个在整个工作表中使用ADO的报告。 As the report generation time is too long (1 min) , I want to implement a progress bar during the report generation .Btw , the report will be produced in a new excel file .
由于报告生成时间太长(1分钟),因此我想在报告生成过程中实现进度条。顺便说一句,该报告将在新的excel文件中生成。
Private Sub CommandButton3_Click()
Dim sSQLQry As String
Dim ReturnArray
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
Dim DBPath As String, sconnect As String
DBPath = ThisWorkbook.FullName
sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';"
Conn.Open sconnect
sSQLSting = "..."
Set rs = Conn.Execute(sSQLSting)
j = 6
Do While Not rs.EOF
with thisworkbook.worksheets("report")
.Cells(j, 1) = rs.Fields(0).Value
.Cells(j, 3) = rs.Fields(2).Value
.Cells(j, 4) = rs.Fields(3).Value
.Cells(j, 7) = rs.Fields(6).Value
End with
j = j + 1
rs.MoveNext
Loop
rs.Close
Dim wb As Workbook
Set wb = Workbooks.Add
ThisWorkbook.Sheets("report").Copy Before:=wb.Sheets(1)
...copy Sheets("report") to wb ...
strFileName = "c:\Users\" & Environ("Username") & "\Desktop\" & ThisWorkbook.Sheets("report").Cells(1, 1) & ".xlsx"
'End With
wb.SaveAs strFileName
I read the progress bar codes . 我读了进度条。 It needs to use the loop variable
PctDone = Counter / (RowMax * ColMax)
. 它需要使用循环变量
PctDone = Counter / (RowMax * ColMax)
。 For my codes , it includes different works- SQL calculation , pasting on worksheets("report") , coping worksheets("report") to new workbook .Hence , I don't know how to fit my code with this progress bar application . 对于我的代码,它包含不同的工作-SQL计算,粘贴到工作表(“报告”),将工作表(“报告”)粘贴到新工作簿。因此,我不知道如何使此代码适合此进度栏应用程序。
Reference to Progress bar in VBA Excel 对VBA Excel中的进度栏的引用
If it is impossible to implement progress bar in my case , what can i do tho let the user know "Be patient to wait about 1 min "? 如果在我的情况下无法实现进度条,该如何使用户知道“请耐心等待1分钟”?
You do not need to use a progress bar per se as you can't calculate the percentage of work done. 您不必使用进度条本身,因为您无法计算已完成工作的百分比。 In such a case, it is better to let the user know of what you(or the code is doing).
在这种情况下,最好让用户知道您(或代码在做什么)。 You could use
Application.StatusBar
to update but how many of us actually look down there? 您可以使用
Application.StatusBar
进行更新,但实际上我们当中有多少人看不起? Also there's nothing more fancy than a form popping up and updating you about the status... You can also use Animated GIFS on the userform if you want. 同样,没有什么比弹出表格并更新状态的方法更有趣了。如果需要,您还可以在用户窗体上使用Animated GIFS 。
I tried to use a userform that showing "Please wait one minute` But i find that it need to spend some times on loading the new userform . That makes the whole application much loading time
我尝试使用显示“请稍候”的用户表单,但是我发现它需要花费一些时间来加载新的用户表单。这使整个应用程序花费了很多时间
Ok You never show progress in the UserForm_Initialize()
event of the userform. 好的,您永远不会在
UserForm_Initialize()
事件中显示进度。 Show the progress when the process actually starts. 在进程实际开始时显示进度。 If required, move everything to
UserForm_Activate()
or in a click of a Commandbutton
. 如果需要,将所有内容移至
UserForm_Activate()
或单击Commandbutton
。 I am using UserForm_Click()
for demonstration purpose. 我正在使用
UserForm_Click()
进行演示。
Let's say we have a userform which looks like below with a Frame
and Listbox` control. 假设我们有一个用户窗体,如下所示,其中带有
Frame
and Listbox`控件。
Put this code in the userform 将此代码放在用户表单中
Private Sub UserForm_Click()
ListBox1.AddItem "I am performing something in a loop..."
ListBox1.Selected(ListBox1.ListCount - 1) = True
For i = 1 To 10
Wait 3
Next i
ListBox1.AddItem "I am now writing something to the workbook..."
ListBox1.Selected(ListBox1.ListCount - 1) = True
Range("A1").Value = "Sid"
ListBox1.AddItem "I am performing something again in a loop..."
ListBox1.Selected(ListBox1.ListCount - 1) = True
For i = 1 To 10
Wait 3
Next i
'
'~~> And So on
'
End Sub
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
Logic : 逻辑 :
ListBox1.Selected(ListBox1.ListCount - 1) = True
? ListBox1.Selected(ListBox1.ListCount - 1) = True
吗? This will ensure that the recent most entry is always selected. In Action 行动中
EDIT 编辑
You have misunderstood how it works :) 您误解了它的工作原理:)
Now run the code. 现在运行代码。
Private Sub UserForm_Activate()
ListBox1.AddItem "Generating random numbers..."
ListBox1.Selected(ListBox1.ListCount - 1) = True
DoEvents
For i = 1 To 1000
For j = 1 To 1000
ThisWorkbook.Sheets("content").Cells(i, j) = Rnd
Next
Next
ListBox1.AddItem "Copying and working with Content sheet..."
ListBox1.Selected(ListBox1.ListCount - 1) = True
DoEvents
Row = ThisWorkbook.Sheets("content").Range("A" & Rows.Count).End(xlUp).Row
Set wb = Workbooks.Add
ThisWorkbook.Sheets("content").Copy Before:=wb.Sheets(1)
wb.Sheets(1).Cells(Row, 1) = Application.WorksheetFunction.Sum(wb.Sheets(1).Range("A:A"))
wb.Sheets(1).Cells(Row, 2) = Application.WorksheetFunction.Sum(wb.Sheets(1).Range("B:B"))
wb.Sheets(1).Cells(Row, 3) = Application.WorksheetFunction.Sum(wb.Sheets(1).Range("C:C"))
wb.Sheets(1).Cells(Row, 4) = Application.WorksheetFunction.Sum(wb.Sheets(1).Range("D:D"))
wb.Sheets(1).Cells(Row, 5) = Application.WorksheetFunction.Sum(wb.Sheets(1).Range("E:E"))
wb.Sheets(1).Cells(Row, 6) = Application.WorksheetFunction.Sum(wb.Sheets(1).Range("F:F"))
wb.Sheets(1).Cells(Row, 7) = Application.WorksheetFunction.Sum(wb.Sheets(1).Range("G:G"))
wb.Sheets(1).Cells(Row, 8) = Application.WorksheetFunction.Sum(wb.Sheets(1).Range("H:H"))
wb.Sheets(1).Cells(Row, 9) = Application.WorksheetFunction.Sum(wb.Sheets(1).Range("I:I"))
wb.Sheets(1).Cells(Row, 10) = Application.WorksheetFunction.Sum(wb.Sheets(1).Range("K:K"))
ListBox1.AddItem "Saving File..."
ListBox1.Selected(ListBox1.ListCount - 1) = True
DoEvents
strFileName = "c:\Users\" & Environ("Username") & "\Desktop\" & ThisWorkbook.Sheets("content").Cells(1, 1) & ".xlsx"
wb.SaveAs strFileName
ThisWorkbook.Sheets("content").Cells.Clear
ListBox1.AddItem "Done!"
ListBox1.Selected(ListBox1.ListCount - 1) = True
DoEvents
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.