VBA Excel - Barra de Progresso na Barra de Status - Show a Progress Meter in the Status Bar




Show a Progress Meter in the Status Bar



Olá pessoal!

Complementando o tópico anterior, segue novo Post com opção de utilização da nossa Barra de Status do MS Excel. Chamaremos este exemplo de SHOW A PROGRESS METER IN THE STATUS BAR.

Sim, é bom lembrar que este exemplo de código serve para ampliar a visão sobre como utilizar outras informações úteis na Barra de Status, fica mais um exemplo!

PASSO ÚNICO





Insira o código da função e efetue chamadas a ela.




Sub ShowProgress2()



    ' Author                        Contact                        Place



    ' André Luiz Bernardes          bernardess@gmail.com           http://inanyplace.blogspot.com/



    ' Show a Progress Meter in the Status Bar







    Let Application.DisplayStatusBar = True







    ' 1ª Mensagem



    Let Application.StatusBar = String(5, ChrW(9609)) & "Processando..."







    Application.Wait Now + TimeValue("00:00:02")







    ' 2ª Mensagem



    Let Application.StatusBar = String(10, ChrW(9609)) & "Ainda processando..."







    Application.Wait Now + TimeValue("00:00:02") '-- Replace this line with your own code to do something







    ' 3ª Mensagem



    Let Application.StatusBar = String(15, ChrW(9609)) & "Finalizando..."







    Application.Wait Now + TimeValue("00:00:02") '-- Replace this line with your own code to do something







    Let Application.StatusBar = False



End Sub

References: André Luiz BernardesDataPigTechnologies.com

Tags: Bernardes, iniciantes, MS, Microsoft, Office, VBA, Excel, Status Bar, Barra de Status, Status, information, range, selected



André Luiz Bernardes
A&A® - Work smart, not hard.


2 comentários:

  1. Despois de fitar para a súa idea, decateime de cómo implementar unha barra de progreso sinxela que fose moito máis rápida que outra que tiña a base de formularios.
    Precisei atopar algunha información adicional sobor o ChrW. De todas maneiras Moito obrigado, Thank you so much for your tip.

    Sub BarraProgresoProfesional()
    'http://inanyplace.blogspot.com/
    ' Show a Progress Meter in the Status Bar
    Dim intPorcentajeEjecutado As Integer
    Dim intTeselasBarraProgreso As Integer

    Let Application.DisplayStatusBar = True

    For intPorcentajeEjecutado = 0 To 100
    If (intPorcentajeEjecutado Mod 10) = 0 Then
    VBA.DoEvents
    ' Application.Wait Now + TimeValue("00:00:01")
    'Para visualizar los ChrW [Menu Inicio --> Programas --> Accesorios --> Mapa de caracteres]
    Let Application.StatusBar = VBA.String(intTeselasBarraProgreso, VBA.ChrW(&H2588)) & _
    " (" & intPorcentajeEjecutado & " % ejecutado)" & " - Por favor, espere..."
    intTeselasBarraProgreso = intTeselasBarraProgreso + 1
    End If
    Next intPorcentajeEjecutado

    Let Application.StatusBar = False

    End Sub

    ResponderExcluir
  2. Algunhas modificacións feitas 'a posteriori', agora xá parece profesional de máis, :)).

    Option Explicit
    Public intPorcentajeEjecutadoBarraEstado As Integer
    Public strRelojBarraEstado As String

    Public Function EjemploBarraProgresoEstado()
    Dim lgContador As Long, lgContadorMaximo As Long, lgContadorSalto As Long, lgContadorAuxiliar As Long
    Static intIncrementaPorcentajeEjecutado As Integer

    'Muestra la Barra de Estado
    Let Application.DisplayStatusBar = True

    Call BarraProgresoBarraEstado(0, "Arrancando...", 0, True) 'Llamada a la funcion para arrancar

    lgContadorMaximo = 10000000
    intIncrementaPorcentajeEjecutado = 0
    lgContadorSalto = (lgContadorMaximo / 100)
    Call BarraProgresoBarraEstado(intIncrementaPorcentajeEjecutado) 'Llamada a la funcion para mostrar el primer avance
    For lgContador = 1 To (lgContadorMaximo + 1)
    lgContadorAuxiliar = lgContadorAuxiliar + 1
    If lgContadorAuxiliar > lgContadorSalto Then Call BarraProgresoBarraEstado(1, "Por favor, espere..."): lgContadorAuxiliar = 0
    Next

    intPorcentajeEjecutadoBarraEstado = 0
    Let Application.StatusBar = ""

    End Function

    Public Function BarraProgresoBarraEstado(ByRef intIncrementaPorcentajeEjecutado As Integer, _
    Optional ByRef strTexto As String = "", _
    Optional ByRef intInicial As Integer = 0, _
    Optional ByRef bReinicia As Boolean = False)

    Dim intRespuesta As Integer

    Dim strMostrarTexto As String

    Select Case strRelojBarraEstado
    Case "": strRelojBarraEstado = ""
    Case "|": strRelojBarraEstado = "/"
    Case "/": strRelojBarraEstado = "-"
    Case "-": strRelojBarraEstado = "\"
    Case "\": strRelojBarraEstado = "|"
    End Select

    'Para visualizar los ChrW [Menu Inicio --> Programas --> Accesorios --> Mapa de caracteres]
    If bReinicia Then 'Si es un contador nuevo, lo reinicia aquí.
    If strRelojBarraEstado = "" Then strRelojBarraEstado = "\"
    intPorcentajeEjecutadoBarraEstado = 0
    Let Application.StatusBar = strRelojBarraEstado & " " & strTexto
    Else
    If intInicial > 0 Then intPorcentajeEjecutadoBarraEstado = intInicial
    If intPorcentajeEjecutadoBarraEstado > 100 Then Beep: GoTo ExcesoPorcentaje 'Evita que supere el 100%
    strMostrarTexto = strRelojBarraEstado & " " & strTexto & " (" & intPorcentajeEjecutadoBarraEstado & " % ejecutado) " & _
    VBA.String(intPorcentajeEjecutadoBarraEstado, VBA.ChrW(&H2588)) & _
    VBA.String(100 - intPorcentajeEjecutadoBarraEstado, VBA.ChrW(&H2591))
    If VBA.Len(strMostrarTexto) > 200 Then Beep: GoTo ExcesoTexto 'Evita que se supere el límite de texto de la barra de tareas
    Let Application.StatusBar = strMostrarTexto
    'Añade una tesela, para la siguiente iteración (comienza en '0')
    intPorcentajeEjecutadoBarraEstado = intPorcentajeEjecutadoBarraEstado + intIncrementaPorcentajeEjecutado
    End If
    Exit Function

    ExcesoPorcentaje:
    intRespuesta = MsgBox("Se ha excedido el 100% ejecutado", vbCritical, "A D V E R T E N C I A")
    ExcesoTexto:
    intRespuesta = MsgBox("Se ha excedido el límite de texto que admite la barra de estado", vbCritical, "A D V E R T E N C I A")
    End Function

    ResponderExcluir

diHITT - Notícias