Show a Progress Meter in the Status Bar
Olá pessoal!
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 Bernardes, DataPigTechnologies.com
Tags: Bernardes, iniciantes, MS, Microsoft, Office, VBA, Excel, Status Bar, Barra de Status, Status, information, range, selected
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.
ResponderExcluirPrecisei 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
Algunhas modificacións feitas 'a posteriori', agora xá parece profesional de máis, :)).
ResponderExcluirOption 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