宏运行时vba显示进度条？

Question

我正在尝试显示一个进度条，当我的宏在后台运行时会显示。

这是我的表格：

和表单代码：

这是我的宏：

Option Explicit
Sub code()
    Dim i1 As Integer, j1 As Integer, pctCompl As Single

    UserForm1.Show

    Application.ScreenUpdating = False

    Dim WB As Workbook
    Dim i As Long
    Dim j As Long
    Dim LastRow As Long

    On Error Resume Next
    Set WB = Workbooks("L.O. Lines Delivery Tracker.xlsm")
    On Error GoTo 0
    If WB Is Nothing Then 'open workbook if not open
        Set WB = Workbooks.Open("G:\WH DISPO\(3) PROMOTIONS\(18) L.O. Delivery Tracking\L.O. Lines Delivery Tracker.xlsm")
    End If

    ' ======= Edit #2 , also for DEBUG ======
    With WB.Worksheets(1)
        LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
        j = 2

        For i = 7 To LastRow

            Debug.Print CInt(ThisWorkbook.Worksheets(1).Range("F9").value)
            Debug.Print Month(.Range("G" & i).value)
            Debug.Print CInt(ThisWorkbook.Worksheets(1).Range("F10").value)
            Debug.Print Year(.Range("G" & i).value)
            Debug.Print ThisWorkbook.Worksheets(1).Range("B6").value
            Debug.Print .Range("M" & i).value

            If CInt(ThisWorkbook.Worksheets(1).Range("F9").value) = Month(.Range("G" & i).value) Then ' check if Month equals the value in "A1"
                If CInt(ThisWorkbook.Worksheets(1).Range("F10").value) = Year(.Range("G" & i).value) Then ' check if Year equals the value in "A2"
                If ThisWorkbook.Worksheets(1).Range("B6").value = .Range("M" & i).value Then
                    ThisWorkbook.Worksheets(2).Range("A" & j).value = .Range("G" & i).value
                    ThisWorkbook.Worksheets(2).Range("B" & j).Formula = "=MONTH(B" & j & ")"
                    ThisWorkbook.Worksheets(2).Range("C" & j).value = .Range("L" & i).value
                    ThisWorkbook.Worksheets(2).Range("D" & j).value = .Range("D" & i).value
                    ThisWorkbook.Worksheets(2).Range("E" & j).value = .Range("E" & i).value
                    ThisWorkbook.Worksheets(2).Range("F" & j).value = .Range("F" & i).value
                    ThisWorkbook.Worksheets(2).Range("g" & j).value = .Range("p" & i).value
                    ThisWorkbook.Worksheets(2).Range("H" & j).value = .Range("H" & i).value
                    ThisWorkbook.Worksheets(2).Range("I" & j).value = .Range("I" & i).value
                    ThisWorkbook.Worksheets(2).Range("J" & j).value = .Range("J" & i).value
                    ThisWorkbook.Worksheets(2).Range("k" & j).value = .Range("Q" & i).value
                    ThisWorkbook.Worksheets(2).Range("L" & j).value = .Range("m" & i).value
                    j = j + 1
                End If
                End If
            End If
        Next i
    End With

    Worksheets(1).UsedRange.Columns("B:AA").Calculate
    Application.ScreenUpdating = True
End Sub


Sub progress(pctCompl As Single)
    UserForm1.Text.Caption = pctCompl & "% Completed"
    UserForm1.Bar.Width = pctCompl * 2

    DoEvents
End Sub

由于某种原因，这产生了以下错误：

表格已经显示，无法以模态显示

此进度条应从0到100％完成，直到宏完成。请有人告诉我我哪里出错了吗？