BARRA DE PROGRESO

[SALAVERRINO]

Buenas tardes a los integrantes de este prestigioso foro, en ocasión recurro a Uds, para que brinden su apoyo con la siguiente macro, a la cual quiero que en la barra de estado cuente la cantidad registros que se encuentran en la pestaña PLANILLA que empieza en la celda AZ8 hasta la AZ2507 y por cada archivo que van generando en PDF indique 1 de 19, 2 de 19, .... hasta llegar a 19 de 19, desde ya agradezco su apoyo y colaboración.

Sub ElegirAccion()
    Dim i As Integer
    Dim intInicial As Integer
    Dim intFinal As Integer
    Dim intConsecutivo As Integer
    Dim srtTitulo As String
    Dim Ruta As String
    Dim nombre As String
    Dim pass As String, hoja As String
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Sheets("BOLETA PDF").Activate
    hoja = "BOLETA PDF"
    
    nombre = ThisWorkbook.Sheets("PLANILLA").Range("BC8").Value
    
    srtTitulo = "PRUEBITA"
    intConsecutivo = ThisWorkbook.Sheets("BOLETA PDF").Range("CONSECUTIVO").Value
    
    intInicial = Sheets("PLANILLA").Range("AZ8")
    intFinal = Sheets("BOLETA PDF").Range("M3")
    
    If intFinal < intInicial Or intFinal > intConsecutivo Then
        MsgBox "Valida el ID final.", vbExclamation, srtTitulo
    Else
        Sheets("BOLETA PDF").Select
        Ruta = ActiveWorkbook.Path & "\BOLETAS"
        For i = intInicial To intFinal
            
            ThisWorkbook.Sheets("BOLETA PDF").Range("L4").Value = i
            
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Ruta & "\" & Sheets("BOLETA PDF").Range("B6") & ".pdf", _
            Quality:=xlQualityMinimum, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            
        Next i
    End If
    
    MsgBox "Boletas Generadas...... ", , "AVISO"
    Sheets("MENU").Activate
    Range("B8").Select
    
    intInicial = Sheets("PLANILLA").Range("AZ8")
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

anexo archivo.

CONSOLIDADO BUNA ARROW PTO MATARANI 1-7-2021 19-4-51 HRS.xlsm

[Mauricio_ODN]

Hola @SALAVERRINO

Te comparto una posible solución.

Nos comentas, Saludos.

Sub ElegirAccion()
    Dim i As Long
    Dim intInicial As Integer
    Dim intFinal As Integer
    Dim intConsecutivo As Integer
    Dim srtTitulo As String
    Dim Ruta As String
    Dim nombre As String
    Dim pass As String, hoja As String
    Dim oPj As Double
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Sheets("BOLETA PDF").Activate
    hoja = "BOLETA PDF"
    
    nombre = ThisWorkbook.Sheets("PLANILLA").Range("BC8").Value
    
    srtTitulo = "PRUEBITA"
    intConsecutivo = ThisWorkbook.Sheets("BOLETA PDF").Range("CONSECUTIVO").Value
    
    intInicial = Sheets("PLANILLA").Range("AZ8")
    intFinal = Sheets("BOLETA PDF").Range("M3")
    

''linea añadida
    UserForm1.Show
    
    If intFinal < intInicial Or intFinal > intConsecutivo Then
        MsgBox "Valida el ID final.", vbExclamation, srtTitulo
    Else
        Sheets("BOLETA PDF").Select
        Ruta = ActiveWorkbook.Path & "\BOLETAS"
        
        For i = intInicial To intFinal
            

''lineas añadidas
            oPj = Round(i / intFinal, 2) * 100
            Application.StatusBar = "Procesando el archivo... " & i & " de " & intFinal & " - " & oPj & "% Completed"
            UserForm1.Label1.Caption = "Procesando el archivo... " & i & " de " & intFinal & " - " & oPj & "% Completed"
            Application.Wait (Now + TimeValue("0:00:01"))

            ThisWorkbook.Sheets("BOLETA PDF").Range("L4").Value = i
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Ruta & "\" & Sheets("BOLETA PDF").Range("B6") & ".pdf", _
            Quality:=xlQualityMinimum, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

        Next i
    End If
    
    Application.StatusBar = False
    Unload UserForm1
    
    MsgBox "Boletas Generadas...... ", , "AVISO"
    Sheets("MENU").Activate
    Range("B8").Select
    
    intInicial = Sheets("PLANILLA").Range("AZ8")
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

-->>

Habrá que crear el userform1 (adjunto el que use, no puedo compartirte el archivo por su peso)

UserForm1.frm UserForm1.frx

[SALAVERRINO]

Hola @Mauricio_ODN, me podrias enviar los archivos a mi email, jlcarpio_davila@hotmail.com 

Gracias.

[Mauricio_ODN]

Hola de nuevo @SALAVERRINO

Acabo de enviarlo, nos comentas.

Saludos.

[SALAVERRINO]

Hace 26 minutos , Mauricio_ODN dijo:

Hola de nuevo @SALAVERRINO

Acabo de enviarlo, nos comentas.

Saludos.

Gracias @Mauricio_ODNpor el aporte quedo bien y era lo que estaba requeriendo.

[SALAVERRINO]

Gracias por el aporte @Mauricio_ODNy daría por TEMA SOLUCIONADO.?