Escola SaberExcel VBA Estudos - Treinamento com Macros, Fórmulas e Funções

Esse procedimento do Microsoft Excel VBA(Visual Basic Application) retorna um objeto Label(Rótulo) uma saduação dependendo do Horario atual:
Espero que o exemplo possa lhe ser útil. Fique com Deus, Expedito Marcondes.

Private Sub UserForm_Initialize()
On Error Resume Next
lbAGORA.Caption = "Escola Saberexcel VBA Estudos - [Agora:... " & Format(Now(), "dddd - dd-mmm-yyyy hh:mm:ss") & " ]"

Select Case Time
Case Is < TimeValue("12:00:00"): Me.lbSAUDACAOHORA.Caption = "Bom Dia Amigo, " & Application.UserName & "!" _
& vbCrLf & "Desejo-lhe todo bem!"
Case Is >= TimeValue("19:00:00"): Me.lbSAUDACAOHORA.Caption = "Boa Noite, Amigo " & Application.UserName & "!" _
& vbCrLf & "Desejo-lhe todo bem!"
Case Else: Me.lbSAUDACAOHORA.Caption = "Boa Tarde, Amigo " & Application.UserName & "!" & "" _
& vbCrLf & "Seja Bem vindo, Bons Estudos!!!!"
End Select

End Sub

Private Sub lbSAUDACAOHORA_Click()
Unload Me
End Sub

Private Sub UserForm_Click()
Unload Me
End Sub


Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.

Saberexcel - o site de quem precisa aprender Macros Microsoft Excel VBA.

'Site...: http://www.microsoftexcel.com.br
'E_mail.: [email protected]   Excel planilha vba wkf contse total ocorrencia intervalo horas
'......................................'

Option Explicit

Public Sub contar_ocorrencia_horas_intervalos()
Dim wks As Worksheet
Dim vContador As Long

Set wks = ActiveSheet
limpar
'mensagem estática para o tempo de 9 às 10 horas:
MsgBox "De : [ 9 ] até [10] : " & (WorksheetFunction.CountIf(wks.Columns(2), ">=09:00:00") - _
WorksheetFunction.CountIf(wks.Columns(2), ">=10:00:00")) & " Ocorrencias"

'Com um loop de 24 horas.
'cada hora a contagem de ocorrências na coluna B e para fazer o teste
'mude o horario mas preservando o formato

For vContador = 0 To 23
wks.Cells(vContador + 2, 4) = "De : [ " & vContador & " ] até [" & vContador + 1 & " ]"

wks.Cells(vContador + 2, 5) = _
(WorksheetFunction.CountIf(wks.Columns(2), ">=" & vContador & ":00:00") - _
WorksheetFunction.CountIf(wks.Columns(2), ">=" & vContador + 1 & ":00:00"))
wks.Cells(vContador + 2, 6).Value = "Ocorrencias"

Next vContador

Set wks = Nothing
End Sub

Sub limpar()
[D2:F25].ClearContents
End Sub

Sub ver_shapes()
Saber1.Shapes("sb").Visible = True
End Sub

Sub oc()
Saber1.Shapes("sb").Visible = False
End Sub

Sub visualizar_modulo_vbe()
Dim resposta As String
resposta = MsgBox("Deseja visualizar as macros no módulo VBE", vbYesNo, "Saberexcel - o site das macros")
If resposta = 6 Then
Application.Goto reference:="contar_ocorrencia_horas_intervalos"
End If
End Sub




Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel

Saberexcel - o site de quem precisa Aprender Lidar Macros Microsoft Excel VBA


Option Explicit

Public Iniciar_Tempo As Variant 'programção do horário
Public Const vIntervaloSegundos = 5 '5 segundos
Public Const vMensagem = "Pequena_Mensagem" 'nome da macro a ser executada

Sub Repetir_Mensagem()
'Programação do horário mantém + 5 segundos
Iniciar_Tempo = TimeValue(Now + TimeSerial(0, 0, vIntervaloSegundos))
Application.OnTime Iniciar_Tempo, vMensagem
End Sub

Sub Parar_mensagem()
On Error Resume Next
Application.OnTime Iniciar_Tempo, vMensagem, , False
End Sub

Sub Pequena_Mensagem()
Dim sbx
'mensagem será gravada na coluna(b) e (D) - intenção didática
[B65000].End(xlUp).Offset(1, 0).Value = Iniciar_Tempo
[B65000].End(xlUp).Offset(0, 2).Value = "Hora de Aprender VBA(Saberexcel)"

sbx = MsgBox("Se escolher 'NÃO', a mensagem continua !" & vbLf _
& "Quer parar a mensagem ?", _
vbQuestion + vbYesNo + vbDefaultButton2, _
"Escola Saberexcel VBA Treinamentos - Horários")

If sbx = 7 Then
'continuar a repetir a mensagem

Repetir_Mensagem
Else
'parar a programação de repetição da mensagem
Parar_mensagem
End If

End Sub

Sub limpar_teste()
Saber1.[b2:d40].ClearContents
End Sub

Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos SaberExcel

Saberexcel site das macros

Alternativamente, esse exemplo é o mais indicado para realização de algum trabalho com decrementação de segundos(horas)
porque você não tem que ficar na espera da conclusão do loop contador o uso da função "DoEvents", que permite devolver
o controle ao sistema operacional ... espero que o exemplo lhe seja útil - Fique com Deus, E_Marcondes

Sub Decrementando_segundos_I()
Dim sb As Single, i As Integer
Range("A1").Value = 120
sb = Timer
For i = 120 To 1 Step -1
Do While Timer < sb + 1
DoEvents
Loop
Range("A1").Value = Range("A1").Value - 1
sb = Timer
Next i
End Sub
'----------------------------------------------------------'

Aqui também a instruçao for next(loop) usando "DoEvents"
o usuario não fica na espera.
Sub Decrementando_segundos_II()
Dim i As Integer
Dim sb For i = 20 To 0 Step -1
Range("A1") = i
sb = Timer() + 1
Do: DoEvents: Loop While Timer() < t
Next i
MsgBox "Loop concluido decrementando segundos"
End Sub

'----------------------------------------------------------'

Aqui falta do uso adequado da funcao 'DoEvents' usuario tem que ficar
na espera da conclusão do loop, observe.

Sub Decrementando_segundos_III()
Dim i As Single
Range("A1").Value = 20
i = Timer
Do While Timer < i + 20 And Range("A1").Value > 0
Application.Wait (Now + TimeValue("0:00:01"))
Range("A1").Value = Range("A1").Value - 1
Loop
End Sub



Função DoEvents

Exemplo Informações específicas

Cede o controle da execução para que o sistema operacional possa processar outros eventos.

Sintaxe

DoEvents( )

Comentários
A função DoEvents retorna um Número inteiro que representa o número de formulários abertos em versões autônomas do Visual Basic, como o Visual Basic, Professional Edition. DoEvents retorna zero a todos os outros aplicativos.

DoEvents passa o controle para o sistema operacional. O controle é retornado depois que o sistema operacional conclui o processamento dos eventos da sua fila e todas as chaves da fila SendKeys terem sido enviadas.

DoEvents tem uma maior utilidade com ações simples como permitir que um usuário cancele um processo após ter sido iniciado, por exemplo, uma procura por um arquivo. Para processos de longa execução, o controle do processador é conseguido com maior facilidade usando-se um cronômetro ou delegando-se a tarefa a um componente ActiveX EXE. Nesse último caso, a tarefa pode continuar de forma completamente independente de seu aplicativo e o sistema operacional considera a multitarefa e a divisão de tempo.

Atenção sempre que você ceder temporariamente o processador dentro de um procedimento do evento, certifique-se de que o procedimento não seja executado novamente a partir de uma parte diferente do seu código antes que a primeira chamada retorne, pois isto pode causar resultados imprevisíveis. Além disso, não use DoEvents se houver possibilidade de outros aplicativos interagirem com o seu procedimento de forma imprevisível quando você cedeu o controle.

Exemplo da função DoEvents

Este exemplo usa a função DoEvents para fazer com que a execução seja submetida ao sistema operacional uma vez a cada 1000 iterações do loop. DoEvents retorna o número de formulários abertos do Visual Basic, mas somente quando o aplicativo host for o Visual Basic.

' Crie uma variável para conter o número de formulários do Visual Basic
' carregados e visíveis.

Dim I, OpenForms
For I = 1 To 150000 ' Inicie loop.
If I Mod 1000 = 0 Then ' Se o loop tiver se repetido 1000 vezes.
OpenForms = DoEvents ' Submeter ao sistema operacional.
End If
Next I ' Incrementar o contador de loops

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA (Visual Basic Application), sozinho, com baixo custo,
praticando com os produtos didáticos SaberExcel

Saberexcel - o site das macros
Insira os seguintes objetos no módulo VBA (Visual Basic Application)
'1 - Userform
'1 - Label1


'Estas macros mostram horas através de um userform, horas continuas
Relógio digital 2010-07-20 21:26:19

Os procedimentos são inseridos nos modulos comuns e nas
folhas de códigos do Objeto Userform

EM UM MÓDULO COMUM INSIRA OS SEGUINTES CÓDIGOS:

Global onOff As Boolean

'termina o ciclo de atualização por
'encerramento do formulário

Sub ver_formulario()
UserForm1.Show
End Sub

Sub MostrarHoras()
On Error Resume Next
'colocação da data e horas devidamente formatadas
UserForm1.Caption = "Agora :" & Format(Now, "dddd dd-mm-yyyy hh:mm:ss")
UserForm1.Label1.Caption = "Agora :" & Format(Now, "dddd dd-mm-yyyy hh:mm:ss")
UserForm1.Frame1.Caption = "Agora :" & Format(Now, "dddd dd-mm-yyyy hh:mm:ss")
UserForm1.Frame1.ForeColor = &HFF0000
UserForm1.Label1.ForeColor = &HFFFFFF
UserForm1.Label1.BackColor = &HFF&

'só é executado se o formulário estiver activo
If onOff = True Then
Application.OnTime Now + TimeValue("00:00:01"), "MostrarHoras"
Else
Application.OnTime 0, ""
End If
End Sub

Sub Auto_Open()
On Error Resume Next
UserForm1.Show
End Sub
'
Sub Fecha_userform()
On Error Resume Next
UserForm1.Hide
End Sub

NO MÓDULO DA FOLHA DE CÓDIGO DO OBJETO USERFORM INSIRA OS SEGUINTES CÓDIGOS:

'...........................................................'
Private Sub UserForm_Terminate()
onOff = False
End Sub
'...........................................................'
Private Sub UserForm_Activate()onOff = True ' variável declarada como global as boolean
'inicia o ciclo de a cada segundo actualizar as horas no formulário
Application.OnTime Now + TimeValue("00:00:01"), "MostrarHoras"
End Sub
'...........................................................'

Aprenda microsoft Excel VBA