Como poner un control PROGRESSBAR en hoja excel

Tengo macros que les lleva un tiempo y necesitaría ver el tiempo que le queda con un control PROGRESSBAR.

Necesitaría saber como insertarlo con el código que se está se está ejecutando y como hacer para que se vea éste cuando se está ejecutando una macro vba excel.

Respuesta
4

H o l a:

Te presento 3 formas de ver un ProgressBar

El primero, es con la instrucción: Application. StatusBar, el texto te aparece en la parte inferior izquierda de excel, el código para ponerlo:

Application.StatusBar = "Procesando registro " & reg & " de " & totreg

El código para quitarlo:

Application.StatusBar = False

El segundo, es con un control de formulario llamado ProgressBar, en el siguiente código puedes ver un ejemplo de utilización:

'Ejemplo de progress bar
'Por.dam
    totreg = 10
    ProgressBar1 = 0
    ProgressBar1.Max = totreg
    For reg = 0 To totreg
        ProgressBar1 = reg
        MsgBox "Presiona enter para avanzar el Progress Bar y el StatusBar", vbInformation, "PROGRESS BAR"
    Next
    Unload Me
End Sub

En la siguiente imagen se puede ver el ejemplo:

El tercero, es con un formulario, un label y un frame, este es un ejemplo:

Private Sub UserForm_Activate()
'Referencia: http://support.microsoft.com/kb/211736/es
'Mod.Por.Dante Amor
    LProgress.Width = 0
    principal
End Sub
'
Sub principal()
'Por.Dante Amor
    Application.ScreenUpdating = False
    con = 1
    rep = 10
    Label1 = "Procesando ..."
    '
    fin = Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To fin
        '***
        '
        'Macro
        '
        '***
        If (con * 100) / fin >= rep Then
            UpdateProgressBar rep
            rep = rep + 10
        End If
        con = con + 1
    Next
    Application.ScreenUpdating = True
    Label1 = "Proceso Terminado"
End Sub
'
Sub UpdateProgressBar(ava)
'Por.Dante Amor
    UserForm1.Frame1.Caption = Int(ava) & " %"
    LProgress.Width = LProgress.Width + 30
    DoEvents
    Application.Wait Now + TimeValue("00:00:01")
End Sub

La imagen se vería así:

En cualquiera de las opciones hay que calcular el final, para de ese modo ir presentando un avance, lo más sencillo es cuando se leen registros de 1 a n, pero si son varios pasos o varias macros, entonces por cada paso se deberá registrar un avance.

Si tienes dificultar para presentar un ProgressBar, tendría que ver el código y probarlo para adaptar una opción.

'

S a l u d o s . D a n t e   A m o r

Si es lo que necesitas. Recuerda valorar la respuesta.

Ya lo tengo montado con números aleatorios, pero ahora...

Necesito saber como ponerlo en la macro para que cuando se ejecute el código funcione PROGRESSBAR. y sin generar números aleatorios, es decir que se relacione única y exclusivamente con la macro.

Muchas gracias

Tendrías que poner tu macro y decirme cuál de las 3 opciones es la que quieres montar.

Hola Dante, buenos días.

Te adjunto el código en el que necesito que se vea el progressbar mientras se ejecuta.

Esto me tiene que servir para otras macros que también tardan un poco. Viendo como va en esta, espero no fallar en las otras.

Dante, un millón de gracias.

La opción que necesito es la tres.

Option Explicit

'Formato para la exportación del mayor
'Gastos e ingresos Usuarios

Sub Formato_Exportacion_Nuevo()
Sheets("Formato Hojas Balances").Select
Application.ScreenUpdating = False
Range("a1:ag500").UnMerge

Dim cuenta As String
Dim n As Integer

cuenta = Range("d2").Value

'Borra las columnas
Columns("o:t").Select
Selection.Delete Shift:=xlToLeft
Columns("j:j").Select
Selection.Delete Shift:=xlToLeft
Columns("g:h").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Columns("a:c").Select
Selection.Delete Shift:=xlToLeft
'Mueve columna fecha y cuenta colocándolas
Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").Select
Selection.Cut Destination:=Columns("D:D")
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
'Borra primeras filas
' Rows("1:10").Select
' Selection.Delete Shift:=xlUp
' Rows("2:4").Select
' Selection.Delete Shift:=xlUp
'Ajusta el ancho de las columnas
Columns("B:B").Select
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").Select
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").Select
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").Select
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").Select
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").Select
Columns("G:G").EntireColumn.AutoFit
'Inserta columna para poner CCC
' Columns("d:d").Select
' Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
' Range("d1").Value = " C. C. C. "
'Range("P4:U6").Select
'Application.CutCopyMode = False
'Range("d2").Value = cuenta
' Range("K1").Value = cuenta
'n = 1

'Sheets("Hoja1").Select
'Range("h1").Select
'
' Do While ActiveCell.Offset(n, 0) <> ""
' Range("K1").Select
' Application.CutCopyMode = False
' Selection.Copy
' ActiveCell.Offset(n, -7).Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False
' Range("B1").Select
'
' n = n + 1
' Loop
'Elimina las dos últimas filas una en blano y la otra con los totales
' Range("e1").Select
' Selection.End(xlDown).Select
' Selection.End(xlDown).Select
' ActiveCell.EntireRow.Delete
' Selection.End(xlDown).Select
' ActiveCell.EntireRow.Delete
'Elimina la columna A
' Columns("a:a").Select
' Selection.Delete Shift:=xlToLeft
' Elimina la primera fila
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("a1").Select
'Copia los mayores ya formateados a las hojas de
'Balances Gastos Usuarios y a Balances Informes Transferencia ya
'eliminados los ingresos en esta hoja.

Sheets("Formato Hojas Balances").Select
Range("a1").CurrentRegion.Select
Selection.Copy

Sheets("Balances Gastos Usuarios").Select
Range("j1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Balances Informes Transferencia").Select
Range("j1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("Balances Informes").Select
Range("j1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Call Elimina_Ingesos

MsgBox ("Formatos concluidos")
End Sub

Entonces tienes que crear un formulario con los siguientes controles:

- Frame1, con Width de 306

- Dentro del Frame1 un Label con (name) = LProgress y width de 30

- Un Label1

Todo el código va en el formulario:

Private Sub UserForm_Activate()
'Referencia: http://support.microsoft.com/kb/211736/es
'Mod.Por.Dante Amor
    LProgress.Width = 0
    principal
End Sub
Sub principal()
'Por.Dante Amor
    Application.ScreenUpdating = False
    con = 1
    rep = 10
    Label1 = "Procesando ..."
    '
    'Act. Por. Dante Amor
    Sheets("Formato Hojas Balances").Select
    Range("a1:ag500"). UnMerge
    '
    UpdateProgressBar rep
    rep = rep + 10
    '
    cuenta = Range("d2").Value
    'Borra las columnas
    Columns("o:t").Delete Shift:=xlToLeft
    Columns("j:j").Delete Shift:=xlToLeft
    Columns("g:h").Delete Shift:=xlToLeft
    Columns("E:E").Delete Shift:=xlToLeft
    Columns("a:c").Delete Shift:=xlToLeft
    '
    UpdateProgressBar rep
    rep = rep + 10
    '
    'Mueve columna fecha y cuenta colocándolas
    Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("A:A").Cut Destination:=Columns("D:D")
    '
    UpdateProgressBar rep
    rep = rep + 10
    '
    Columns("A:A").Delete Shift:=xlToLeft
    '
    UpdateProgressBar rep
    rep = rep + 10
    '
    'Ajusta el ancho de las columnas
    Columns("B:B"). EntireColumn. AutoFit
    Columns("C:C"). EntireColumn. AutoFit
    Columns("D:D"). EntireColumn. AutoFit
    Columns("E:E"). EntireColumn. AutoFit
    Columns("F:F"). EntireColumn. AutoFit
    Columns("G:G"). EntireColumn. AutoFit
    '
    UpdateProgressBar rep
    rep = rep + 10
    '
    ' Elimina la primera fila
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    '
    UpdateProgressBar rep
    rep = rep + 10
    '
    'Copia los mayores ya formateados a las hojas de
    'Balances Gastos Usuarios y a Balances Informes Transferencia ya
 'eliminados los ingresos en esta hoja.
    Sheets("Formato Hojas Balances").Select
    Range("a1"). CurrentRegion. Copy
    '
    Sheets("Balances Gastos Usuarios").Select
    Range("j1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    '
    UpdateProgressBar rep
    rep = rep + 10
    '
    Sheets("Balances Informes Transferencia").Select
    Range("j1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    '
    UpdateProgressBar rep
    rep = rep + 10
    '
    Sheets("Balances Informes").Select
    Range("j1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    '
    UpdateProgressBar rep
    rep = rep + 10
    '
    Call Elimina_Ingesos
    '
    UpdateProgressBar rep
    rep = rep + 10
    '
    Application.ScreenUpdating = True
    Label1 = "Formatos concluidos"
End Sub
Sub UpdateProgressBar(ava)
'Por.Dante Amor
    UserForm1.Frame1.Caption = Int(ava) & " %"
    LProgress.Width = LProgress.Width + 30
    DoEvents
    'Application. Wait Now + TimeValue("00:00:01")
End Sub

La idea es poner un 10 por ciento de avance a cada uno de los procesos que tienes, no sé que tengas en la macro "Elimina_Ingesos", pero también le puse un 10 %

Si tienes dificultades para adaptar el formulario, envíame tu archivo.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Carlos Martin” y el título de esta pregunta.

S a l u d o s . D a n t e   A m o r. Recuerda valorar la respuesta. G r a c i a s

Hola Dante

Ante todo, muy agradecido

Lo he probado y va perfecto.

Necesito saber como podría modificar el avance, en lugar de 10 preferiría otro valor más bajo.

Saber si se podría crear un bucle o un for para simplificar la ejecución de la barra progressbar.

La macro es genial.

Muchas gracias

En tu caso no se puede, solamente dividí tu macro en 10 partes.

Recuerda valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

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...
1 respuesta

Activar / Desactivar Botón en Excel con condición

Estoy trabajando con un Botón dentro de la "Hoja1" que al oprimirse ejecuta una macro y que sólo deberá estar activado cuando el contenido de una celda concreta (B2:C2) no esté en blanco o con valor 0. ¿Cómo puedo hacerlo?
1 respuesta

Macro que se ejecuta al cambio de una celda

Voy a intentar explicar mi problema: Gracias al foro logre crear una macro que se ejecuta al cambiar una celda con un valor especifico, esas me funciono de maravilla, luego necesite uan que se ejecute cuando otra celda sufra cualquier tipo de cambio,...
1 respuesta

Enviar datos a otra columna sin duplicados,

Resulta que en una columna tengo estos datos así (solo pondré 10 datos pero en realidad son 300) 1 2 4 6 1 7 8 9 4 1 Ahora quiero enviar estos datos a otra columna pero no en la misma pestaña de excel, si no que en otra pestaña, pero sin que se...
2 respuestas

Macro para buscar valor "#N/A" en una columna

Me podrían ayudar con esta macro, Tengo una macro que me genera un reporte de inventario en un archivo excel, el archivo tiene códigos y formulas para la descripción de cada código, Ejemplo. Código descripción 001 zanahorias. 002 cebollas. 003...
1 respuesta

Implementar Progress Bar en macro para generar efecto visual

Sub Buscar() 'Mod.Por.DAM Application.ScreenUpdating = False Set h1 = Sheets("Estados de cuenta") Set h2 = Sheets("Cartera.") ' h1.Range("A18:E6000").ClearContents j = 18 Set r = h2.Columns("G") Set b = r.Find(h1.Range("A6"), LookIn:=xlValues,...
1 respuesta

Tengo un archivo en excel que debo convertir a .TXT

Tengo un archivo en excel que debo convertir a .TXT. El excel tiene varias columnas con diferentes formatos, y el TXT que debo crear tiene un determinado diseño, usando los campos del excel debo generar el txt, pero por ejemplo las longitudes no son...
1 respuesta

Macro no recorre todas las celdas

Grabe una macro para que me extajera al lado de una columna una parte de esa, el problema es que cada archivo tiene diferente Nº de filas y solo me recorre las mismas filas que tenia el archivo con la que la grabe. Os paso la macro para que veáis...
1 respuesta

Copiar De una hoja a otra datos determinados

Y a ver si me podéis ayudar porque llevo mucho rompiéndome la cabeza con esto y no consigo saber si se puede hacer. Tengo un libro con dos hojas. En la primera (Hoja 1) Tengo una "base de datos" en la que en la que: Columna A :Nombre productos;...
1 respuesta

Alto de fila II

Otra vez con dudas... Te comento, en una consulta anterior, me facilitaste la siguiente macro: Sub formato() Dim acolb As Double, acolc As Double, acold As Double, acole As Double Application.ScreenUpdating = False If Sheets("Registre").Visible =...
1 respuesta