BARRA DE PROGRESO

SALAVERRINO · el 16 de julio

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 · el 16 de julio

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