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