Utilizar un Userform como Barra de progreso
Pude observar varios ejemplos sobre este tema pero no logro entender el funcionamiento de un Userform como barra de progreso.
Entre los casos que pude observar en los ejemplos que hay en el foro, no logro entender donde introducir mi código. En otros casos que pude encontrar en la web pude encontrar algunos que me indicaban donde se debía poner el código, pero el tema es que hace el proceso una y otra vez (y encima no me funciona el incremento).
Les adjunto un archivo para que vean (y en lo posible que me puedan ayudar). En dicho archivo hay 3 cosas:
1) La macro funcionando bien, pero sin barra.
2) Una barra que conseguí en la web pero que me crea el loop eterno.
3) Hay cargado un userform que no se como poner mi código para que funcione.
Toda ayuda que me puedan dar para comprender en donde estoy fallando, seria muy agradecido.
Archivo:
1 Respuesta
Revisé tu archivo. El userform que tiene una barra "En progreso", se utiliza cuando tienes un proceso sobre los registros y vas leyendo registro por registro. En tu caso la macro que tienes no lo hace registro por registro, más bien tienes varios pasos, de copiar, pegar, subtotales, borrar, etc.
Después de revisar tu macro, entendí obtienes un acumulado por código y lo pones en otra hoja.
Si la barra de progreso la requieres porque la macro es muy lenta, te sugiero que pongas esta instrucción al principio de tu macro:
Application.ScreenUpdating = False
Por otra parte, realicé una macro que te genera los mismos acumulados por código, pero en lugar de utilizar subtotales, utiliza una tabla dinámica, la ejecución de la macro es inmediata, por lo tanto, no necesitas de una barra de progreso.
Te anexo la macro:
Sub TablaDinamica()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Base de datos")
Set h2 = Sheets("Exhibiciones")
h2.Range("A:C").Clear
u = h1.Range("A" & Rows.Count).End(xlUp).Row
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
h1.Name & "!R1C1:R" & u & "C6", Version:=xlPivotTableVersion12). _
CreatePivotTable TableDestination:=h2.Name & "!R1C1", TableName:= _
"Tabla dinámica2", DefaultVersion:=xlPivotTableVersion12
With h2.PivotTables("Tabla dinámica2")
.PivotFields("Codigo").Orientation = xlRowField
.PivotFields("Codigo").Position = 1
.PivotFields("Descripcion").Orientation = xlRowField
.PivotFields("Descripcion").Position = 2
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
h2.PivotTables("Tabla dinámica2").AddDataField h2.PivotTables _
("Tabla dinámica2").PivotFields("Exhibicion"), "Suma de Exhibicion", xlSum
h2.PivotTables("Tabla dinámica2").ColumnGrand = False
h2.PivotTables("Tabla dinámica2").PivotFields("Codigo").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
h2.Select
Application.ScreenUpdating = True
MsgBox "Se calcularon los nuevos valores de la exhibicion.", vbOKOnly, "Notificacion."
End SubTambién te anexo tu archivo con el botón para ejecutar la nueva macro.
https://www.dropbox.com/s/0de9f8rg5dmfxdj/Ejemplo%20dam.xlsm?dl=0
Saludos. Dante Amor
Wow! La veradad no esperaba esta respuesta sino una explicacion de porque no realizaba la ejecucion de una barra. Sin embargo esta respuesta soluciona este caso. Te molesto con una ultima consulta: que me quieres decir con "se utiliza cuando tienes un proceso sobre los registros y vas leyendo registro por registro"?
Agradezco tu ayuda, muy amable de tu parte.
Esta es la macro de la barra:
Sub principal()
'Por.DAM
Application.ScreenUpdating = False
ini = 9
Fin = 3900
con = 0
rep = 1
For Each R In Range("B" & ini & ":B" & Fin)
If R = "" Then R.EntireRow.Hidden = True
avance = con / (Fin - ini)
If Int(avance * 10) = rep Then
UpdateProgressBar avance
rep = rep + 1
End If
con = con + 1
Next R
'Unload UserForm1
End SubLo que hace es un ciclo de la fila 9 y terminar en la fila 3900 (todo esto es un ejemplo).
La macro lleva un contador en la variable "con", por cada registro que se lee, con se incrementa en 1, cuando el contador llega a 10, entonces se ejecuta la macro UpdateProgressBar y lo que hace es incrementar el tamaño de un Label dentro del userform.
A eso me refiero con procesar registro por registro.
Tu macro tiene esto:
- Columns("A:E").Select
Selection. Copy
otro paso:
- ActiveWorkbook. Worksheets. Add
otro paso:
- Columns("A:A").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Este paso es el que más se tarda:
- Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Lo que tienes en tu macro son procesos, se tendría que adaptar la barra, para ejecutar la macro UpdateProgressBar, entre cada paso.
Quedaría así por ejemplo:
Private Sub UserForm_Activate()
'Referencia: http://support.microsoft.com/kb/211736/es
'Mod.Por.DAM
UserForm1.LProgress.Width = 0
principal
End Sub
Sub principal()
'Por.DAM
Application.ScreenUpdating = False
Dim UltimaFilC As Long
Sheets("Base de datos").Select
Columns("A:E").Select
Selection. Copy
ActiveWorkbook. Worksheets. Add
'
UpdateProgressBar 0.1
'
ActiveSheet.Name = "recalculo"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Sort Key1:=Range("a2"), Order1:=xlAscending, Header:=xlYes
Range("A:C").Select
'
UpdateProgressBar 0.2
'
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Columns("A:C").Select
'
UpdateProgressBar 0.5
'
Sheets("Exhibiciones").Select
Columns("A:C").Select
Selection.Delete Shift:=xlToLeft
Sheets("recalculo").Select
Selection.Copy
Sheets("Exhibiciones").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'
UpdateProgressBar 0.8
'
Application.CutCopyMode = False
Range("a1").Select
Range("A1").Sort Key1:=Range("b2"), Order1:=xlAscending, Header:=xlYes
UltimaFilaB = Cells(Rows.Count, "B").End(xlUp).Row
Range("a2:C" & UltimaFilaB).Select
Selection.Delete Shift:=xlUp
Range("A1").Select
'Por.Dante Amor
'Do While ActiveCell <> Empty
'ActiveCell.Offset(1, 0).Select
'Loop
Selection.End(xlDown).Offset(1, 0).Select
'Por.Dante Amor
'
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 9), Array(6, 1)), TrailingMinusNumbers:=True
Range("A1").Select
ActiveCell.FormulaR1C1 = "Codigo"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],recalculo!C[-1]:C,2,0)"
UltimaFilC = Cells(Rows.Count, "A").End(xlUp).Row
Range("b2:b" & UltimaFilC).FillDown
Columns("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'
UpdateProgressBar 0.9
'
Application.CutCopyMode = False
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Sheets("recalculo").Select
Application.DisplayAlerts = False
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.Delete
Sheets("Base de datos").Select
Range("a1").Select
'
UpdateProgressBar 1
'
Application.StatusBar = False
End Sub
Sub UpdateProgressBar(ava)
'Por.DAM
UserForm1.FProgress.Caption = Format(ava, "0%")
UserForm1.LProgress.Width = ava * (UserForm1.FProgress.Width - 10)
DoEvents
End SubSaludos.Dante Amor (Dam)
