Mostrar barra de progreso al ejecutar una macro
Necesito mostrar una barra de progreso mientras se ejecuta una macro que demora varios segundos, como para que el operario sepa esperar con paciencia y no crea que la PC se "tildó" o "colgó".
He intentado adapatar el código del siguiente link: Crear barra de progreso para macros, pero no lo he conseguido pese a que respeto lo que va en el módulo y lo que va en el formulario.
La barra de progreso funcionaría si tuvieras al macro "alertas" dentro del formulario.
En este caso tienes la macro en un módulo. Para este caso podría funcionarte la instrucción
Application. StatusBar
Para ver el avance quedaría así:
Sub Alertas()
Dim filas As Integer
filas = 0
uf = Sheets("Resumen").Range("B" & Rows.Count).End(xlUp).Row
Range("E6:F" & uf).Select
Selection.NumberFormat = "#,##0"
Application.ScreenUpdating = False
Application.StatusBar = False
ini = 6
fin = uf
con = 0
For i = 6 To uf
Application.StatusBar = "Procesando macro Alertas. Registro : " & i & " De : " & uf
If Sheets("Resumen").Cells(i, 1) <> Empty Then
filas = filas + 1
If Sheets("Resumen").Cells(i, 6).Value = "" Then
kmproxserv = -1001
End If
If Not Sheets("Resumen").Cells(i, 6).Value = "" Then
kmproxserv = Range("E4").Value - Sheets("Resumen").Cells(i, 6).Value
End If
If kmproxserv > -1001 And kmproxserv < 0 Then
kmproxserv = kmproxserv * -1
With Sheets("Resumen").Cells(i, 8).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Sheets("Resumen").Cells(i, 8).Value = Sheets("Resumen").Cells(i, 8).Value & " - ATENCION...!!!: Faltan " & kmproxserv & " km. para el próximo servicio"
Sheets("Resumen").Cells(i, 8).Font.Bold = True
kmproxserv = kmproxserv * -1
End If
If kmproxserv >= 0 Then
With Sheets("Resumen").Cells(i, 8).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Sheets("Resumen").Cells(i, 8).Value = Sheets("Resumen").Cells(i, 8).Value & " - ATENCION...!!!: " & kmproxserv & " km. excedidos del servicio"
Sheets("Resumen").Cells(i, 8).Font.Bold = True
End If
Range("G6:G200").Select
Selection.NumberFormat = "dd/mm/yy;@"
Dim hoy, Fechaps As Date
hoy = Range("I4")
If Sheets("Resumen").Cells(i, 7).Value = "" Then
Fechaps = DateAdd("d", hoy, 31)
End If
If Not Sheets("Resumen").Cells(i, 7).Value = "" Then
Fechaps = Sheets("Resumen").Cells(i, 7).Value
End If
dias = DateDiff("d", hoy, Fechaps)
If dias <= 30 And dias > 0 Then
Sheets("Resumen").Cells(i, 8).Value = Sheets("Resumen").Cells(i, 8).Value & " - ATENCION...!!!: Faltan " & dias & " días para el próximo servicio"
Sheets("Resumen").Cells(i, 8).Font.Bold = True
If Not Cells(i, 8).Interior.Color = 255 Then
With Sheets("Resumen").Cells(i, 8).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End If
If dias < 0 Then
dias = dias * -1
Fechaproxserv = dias
Dim ano, mes As Integer
Dim plaz As String
plaz = ""
Do While dias > 364
ano = ano + 1
dias = dias - 365
If dias < 365 Then
plaz = "" & ano & " año "
End If
Loop
Do While dias >= 30
mes = mes + 1
dias = dias - 30
If dias < 30 Then
plaz = plaz & mes & " meses "
End If
Loop
If dias > 0 Then
If Not plaz = "" Then
plaz = plaz & "y " & dias & " días"
End If
If plaz = "" Then
plaz = dias & " días"
End If
End If
If Fechaproxserv >= 0 Then
Sheets("Resumen").Cells(i, 8).Value = Sheets("Resumen").Cells(i, 8).Value & " - ATENCION...!!!: " & plaz & " excedidos del servicio"
Sheets("Resumen").Cells(i, 8).Font.Bold = True
If Not Cells(i, 8).Interior.Color = 255 Then
With Sheets("Resumen").Cells(i, 8).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End If
End If
End If
avance = con / (fin - ini)
UpdateProgressBar avance
con = con + 1
Next i
Application.StatusBar = False
lineas
End SubEl mensaje de avance de registros procesados lo puedes ver en la esquina inferior izquierda d excel:
Muchas gracias, Dante....!!!!
No obstante, deseo encontrar la manera que muestre una barra de progreso, ya que es más visible que statusbar y por ende, el usuario la ve sí o sí.
Teniendo en cuenta lo que comentás en la primera oración, trasladé todo el código al formulario, y, si bien me muestra la barra una vez finalizado el proceso, no cumple con su verdadera función: mostrar poco a poco en qué nivel de ejecución está la macro.
¿Podrías, por favor, volver a echarle una miradita?
En tu archivo tienes varios macros, quieres la barra para todas o solamente para la macro "alertas".
Si solamente es para la de alertas, entonces considera el For para incrementar la barra.
