VBA-两种进度条

给大家推荐两种简单的进度条显示方法，更推荐第一种。

https://www.ixigua.com/7274429330657116691?logTag=3d817643f386391d4f18

方法一：通过窗体显示进度条（推荐）

①新建一个空userform，粘贴下面代码。

Private Sub UserForm_Initialize()
    Dim oLB As Control
    With Me
        .Height = 45
        .Width = 254.25
        Set oLB = .Controls.Add("Forms.label.1", , True)
        With oLB
            .BackColor = H8000000D
            .Height = 24
        End With
    End With
End Sub

②复制下面的代码到程序中调用。注意代码中的“UserForm1”请更改为创建的窗体名称。

Sub main()
    For i = 1 To 10
        ProgressBar i, 10
        inittimer = Timer: Do Until Timer - inittimer = 1: DoEvents: Loop
    Next
End Sub

Sub ProgressBar(Current As Variant, Total As Variant, Optional Title As String)
    With UserForm1
        .Caption = Title & "已完成：" & Current & "/" & Total
        !Label1.Width = Int(Current / Total * 252)
        .Show vbModeless
        DoEvents
    End With
    If Current = Total Then Unload UserForm1
End Sub

方法二：通过状态栏显示进度，注意程序出现卡顿时会无法显示。

Sub main()
    For i = 1 To 10
        progressbar i, 10
        inittimer = Timer: Do Until Timer - inittimer = 1: DoEvents: Loop
    Next
End Sub

Sub progressbar(Current As Variant, Total As Variant, Optional Title As String)
    total_bar = 25  '进度条总数量
    Percent = Title & "已完成：" & Current & "/" & Total
    current_bar = Int(Current / Total * total_bar)
    Application.DisplayStatusBar = True
    Application.StatusBar = String(current_bar, "▉") _
        & String(total_bar - current_bar, "▁") & "▏" & Percent
    If Current = Total Then
        Application.StatusBar = False
    End If
End Sub