Как добавить индикатор в существующий модуль

Question

Я создал макрос и пытаюсь добавить в него индикатор выполнения. Единственное, что я до сих пор делал, - это создание пользовательской формы, в которой у меня есть 4 метки: Метка белой линии = Label1; Метка зеленой линии: Label2; Идет лейбл: Label3; текущая метка: Label4. А вот изображение:

И мой код выполняет следующую функцию: Я принимаю значения из диапазона M: O , вставьте их в B4, B7 и B9 и для каждой отдельной записи для B4, B7 и B9 я создаю документ PDF. Пример: 100 записей для B4, B7 и B9 = 100 PDF-документов. Я хочу создать индикатор выполнения, который отображает весь прогресс. Есть идеи как? Единственное, что мне удалось создать, - это отобразить сообщение в строке состояния и сделать курсор неподвижным.

Код:

Sub SavePDF4()
    Const sPath = "C:\Users\TestMacro\"
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim r As Long
    Dim m As Long
    Application.ScreenUpdating = False
    Set ws1 = ThisWorkbook.Worksheets("Protocol")
    Set ws2 = ThisWorkbook.Worksheets("Input")
    m = ws2.Range("M:O").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Application.Cursor = xlWait
    Application.DisplayStatusBar = True
    Application.StatusBar = "Please Wait.."
    For r = 1 To m
        ws2.Range("J5").Value = Range("J5").Value + 1
        ws1.Range("B4").Value = ws2.Range("M" & r).Value
        ws1.Range("B7").Value = ws2.Range("N" & r).Value
        ws1.Range("B9").Value = ws2.Range("O" & r).Value
        ws1.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=sPath & "Report_" & ws2.Range("J5").Value & ".pdf"
    Next r
    Application.Cursor = xlDefault
    Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub