VBA - Mensagem para fazer o usuário esperar
Esse pequeno recurso é capaz de exibir uma mensagem de espera quando um processo é demorado, demonstrando ao usuário que não ocorreu travamento.
Introdução
Todas as propriedades são configuráveis.
- Dois comandos:
- Iniciar > Ampulheta. Show vbModeless
- Stop > Animar = False
- Três propriedades:
- O texto corrido > TxtLab = "O texto corrido" (por exemplo)
- Velocidade da imagem > VelocidadeS = 3500 por padrão = 3500
- Velocidade do texto > VelocidadeT = 1000 por padrão = 1000
- Impedir a rolagem do ícone > VelocidadeS = -1
- Impedir a rolagem do texto > VelocidadeT = -1
Para alterar a imagem, é preciso ter uma imagem GIF decomposta e
alterar ou adicionar uma "ListImage" com suas imagens.
Também é preciso mudar o "Const NbImage" com base na quantidade de
imagens que haverá em sua "ListImage".
UserForm
No UserForm, nomear Ampulheta:
Option Explicit
Dim TempsS As Long
Dim TempsT As Long
Dim NumImg As Byte
Dim LG3 As Integer
Dim Deb As Integer
Private Sub UserForm_Activate()
Animation
End Sub
Private Sub UserForm_Inicialize()
'------------------------------------------------------------------
'Os dados por padrão
If TxtLab = "" Then
TxtLab = "Processamento em curso, favor esperar..."
End If
If VitesseS = 0 Then
VitesseS = 3500
End If
If VitesseT = 0 Then
VitesseT = 1000
End If
'------------------------------------------------------------------
OteTitleBarre Me.Caption, False
Me.Height = 43
NumImg = 1
ImgAmpulheta.Picture = ListAmpulheta.ListImagens(NumImg).Picture
LabAmpulheta.Caption = TxtLab
LG3 = LabAmpulheta.Width
Animar = True
End Sub
Sub Animation()
While Animer
If VelocidadeS <> -1 Then
TempoS = TempoS + 1
If TempoS = VelocidadeS Then
TempoS = 0
NumImg = NumImg + 1: If NumImg > NbImage Then NumImg = 1
ImgAmpulheta.Picture = ListAmpulheta.ListImagens(NumImg).Picture
End If
End If
If VelocidadeT <> -1 Then
TempoT = TempoT + 1
If TempsT = VelocidadeT Then
TempoT = 0
If Abs(Deb) > LG3 Then Deb = Frame1.Width
LabAmpulheta.Left = Deb
Deb = Deb - 1
End If
End If
DoEvents
Wend
Unload Me
End Sub
Módulo público
Option Explicit
Coloque FALSE para fechar o UserForm
Public Animer As Boolean
'O texto que rola no UserForm,
Public TxtLab As String
'Para adaptar a velocidade de rolagem da ampulheta
Public VelocidadeS As Integer
'Para adaptar a velocidade de rolagem do texto
Public VelocidadeT As Integer
Public Const NbImage = 12
'----------------------------------------------------------------
'Para retirar a barra de título do UserForm
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Const GWL_STYLE = (-16)
Const WS_CAPTION = &HC00000
Const SWP_FRAMECHANGED = &H20
Public Declare Function FindWindowA Lib "user32" _
As Long
Public Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, _
ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long
Public Type POINTAPI
X As Long
Y As Long
End Type
Public m_CursorPos As POINTAPI
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Public Afficher As Boolean
Sub OteTitleBarre(stCaption As String, pbVisible As Boolean)
Dim vrWin As RECT
Dim style As Long
Dim lHwnd As Long
'- Busca do « handle » da janela por seu « Caption »
lHwnd = FindWindowA(vbNullString, stCaption)
If lHwnd = 0 Then
MsgBox "Handle de " & stCaption & "Não foi encontrado", vbCritical
Exit Sub
End If
GetWindowRect lHwnd, vrWin
style = GetWindowLong(lHwnd, GWL_STYLE)
If pbVisible Then
SetWindowLong lHwnd, GWL_STYLE, style Or WS_CAPTION
Else
SetWindowLong lHwnd, GWL_STYLE, style And Not WS_CAPTION
End If
SetWindowPos lHwnd, 0, vrWin.Left, vrWin.Top, vrWin.Right - vrWin.Left, _
vrWin.Bottom - vrWin.Top, SWP_FRAMECHANGED
End Sub
Exemplo de uso
Em uma planilha Excel, dois botões.
No módulo da planilha.
Private Sub CommandButton1_Click()
'Iniciar
Ampulheta.Show vbModeless
End Sub
Private Sub CommandButton2_Click()
'Terminar
Animar = False
End Sub
Foto: © dennizn - Shutterstock.com
Este documento, intitulado 'VBA - Mensagem para fazer o usuário esperar', está disponível sob a licença Creative Commons. Você pode copiar e/ou modificar o conteúdo desta página com base nas condições estipuladas pela licença. Não se esqueça de creditar o CCM (br.ccm.net) ao utilizar este artigo.
