Question

我想参考这个进度条示例。 http://spreadsheetpage.com/index.php/tip/displaying_a_progress_indicator/

关于我的vb工作，我将生成一个在整个工作表中使用ADO的报告。由于报告生成时间太长（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

我读了进度条形码。它需要使用循环变量PctDone = Counter / (RowMax * ColMax)。对于我的代码，它包括不同的工作 - SQL计算，粘贴工作表（＆＃34;报告＆＃34;），处理工作表（＆＃34;报告＆＃34;）到新工作簿.Hence，我不知道知道如何使用此进度条应用程序调整我的代码。

参考 Progress bar in VBA Excel

如果在我的情况下无法实现进度条，我可以做什么让用户知道＆＃34;耐心等待约1分钟＆＃34;？

Answer 1

您无需使用进度条本身，因为您无法计算完成的工作百分比。在这种情况下，最好让用户知道您（或代码正在做什么）。您可以使用Application.StatusBar进行更新，但我们中有多少人真的看不到它们？此外，没有什么比弹出表单和更新状态更有趣...如果需要，您还可以在用户表单上使用Animated GIFS。

我尝试使用显示“请等待一分钟”的用户表单但是我发现需要花费一些时间来加载新的用户表单。这会使整个应用程序加载很多时间

确定您永远不会在userform的UserForm_Initialize()事件中显示进度。显示进程实际启动时的进度。如果需要，请将所有内容移至UserForm_Activate()或点击Commandbutton。我正在使用UserForm_Click()进行演示。

假设我们的用户表单如下所示，其中包含Frame和Listbox`控件。

将此代码放在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

逻辑：

在开始任何流程之前，请将说明添加到列表框中。我在上面的代码中添加了示例流程和描述。请修改它们以满足您的需求。
注意第ListBox1.Selected(ListBox1.ListCount - 1) = True行？这将确保始终选择最近的大多数条目。如果列表框中添加了很多内容，这还可以确保列表框滚动到最新条目。

在行动

修改

你误解了它的运作方式:)

在表单上添加一个列表框，如上图所示。

删除用户窗体中的所有代码并将其替换为此代码

现在运行代码。

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

如何将我的vba与进度条结合使用？

1 个答案: