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
Esse Evento do Aplicativo Microsoft Excel VBA, insere a hora atual da modificação de uma determinada célula em uma determinada range, essa range é delimitada no próprio procedimento no Evento Change na folha de código da folha de planilha.
Essa planilha faz parte das planilhas inteligentes dos Módulos COMO FAZER - Programação Microsoft Excel VBA - Saberexcel


Private Sub Worksheet_Change(ByVal Lugar As Range)
Dim limite_maximo_linha As Integer
limite_maximo_linha = 30 ' altere aqui para limitar a última linha
' faz nada se mais de uma célula modificada ou se deu delete
If Lugar.Cells.Count > 3 Or IsEmpty(Lugar) Then Exit Sub

If Lugar.Column = 3 And Lugar.Row >= 2 And Lugar.Row <= limite_maximo_linha Then
' a condição(SE) IF confirma a modificação das células nos intervalos [C2:C30]
'
' desativa eventos antes de um arquivo ser modificado com digitacao de forma que o evento Change não ocorre.
Application.EnableEvents = False
' descloca duas células à direita (propriedade OffSet() para inserção da hora na linha correspondente
Lugar.Offset(0, 2).Value = Now() 'ou Time() para horas apenas
' ativa novamente o evento Change (digitar na planilha)
Application.EnableEvents = True
End If
End Sub



Aprenda tudo sobre o Aplicativo Aplicativo Microsoft Excel VBA com Saberexcel

Compre com segurança, garantia e ótimos preços nas lojas SubMarino

Saberexcel - o site das Macros
Esse procedimento do Aplicativo Microsoft Excel VBA, retorna uma mensagem de saudação dependendo do horário do computador, BOA MADRUGADA, BOM DIA, BOA TARDE E BOA NOITE. Neste exemplo usei para fins didáticos a saida da mensagem em uma Label(rótulo), no caption do Frame1(Quadro, Modura) e também na célula(C27), esses dados serão inseridos na ocorrencia do Evento Initialize do Objeto Userform.

Private Sub UserForm_Activate()

Dim vSaudacaoHora As Integer
vSaudacaoHora = Hour(Now)

Select Case vSaudacaoHora
Case 1 To 5
Label1.Caption = "Agora são:[ " & Time & " ] horas, tenha um BOA MADRUGADA!" ' retorno no Label
Frame1.Caption = "Agora são:[ " & Time & " ] horas, tenha um BOA MADRUGADA!" ' retorno no Frame1
[C27].Value = "Agora são:[ " & Time & " ] horas, tenha um BOA MADRUGADA!" ' retorno na célula(B27)
Case 6 To 11
Label1.Caption = "Agora são:[ " & Time & " ] horas, tenha um BOM DIA!"
Frame1.Caption = "Agora são:[ " & Time & " ] horas, tenha um BOM DIA!"
[C27].Value = "Agora são:[ " & Time & " ] horas, tenha um BOM DIA!"
Case 12 To 17
Label1.Caption = "Agora são:[ " & Time & " ] horas, tenha um BOA TARDE!"
Frame1.Caption = "Agora são:[ " & Time & " ] horas, tenha um BOA TARDE!"
[C27].Caption = "Agora são:[ " & Time & " ] horas, tenha um BOA TARDE!"
Case 18 To 24
Label1.Caption = "Agora são:[ " & Time & " ] horas, tenha um BOA NOITE!"
Frame1.Caption = "Agora são:[ " & Time & " ] horas, tenha um BOA NOITE!"
[C27].Caption = "Agora são:[ " & Time & " ] horas, tenha um BOA NOITE!"
End Select

End Sub



Aprenda tudo sobre o Aplicativo Microsoft Excel VBA



Baixe o exemplo de planilha com o procedimento acima


Publicidade:

Compre com garantia, segurança e preços baixos na maior loja do país.

Saberexcel - o site das macros
Diferença em segundos de uma determinada data até agora
Essa macro do aplicativo Microsoft Excel VBA insere uma relógio que faz a diferença de data entre uma determinada data o momento de agora e contar os segundos que faz a diferença entre essas datas?
essas macros fazem isso, a segunda pode contar a diferença em segundos entre uma data e outra.
esta macro repete a macro "Relógio_Segundos" a cada 1 segundo!

Sub Relogio_Segundos()
[A2] = Format([A1] - Time, "hh:mm:ss")
Application.OnTime Now + TimeValue("00:00:03"), "Relogio_Segundos"
End Sub

Este relógio conta os segundos de uma determinada data por exemplo
neste momento é 02/11/2007 10:49:22 (A1) - e inseri a macro para ver
a diferença em segundos, acione a macro A2

Sub Relogio_diferença_Segundos()
[A2] = DateDiff("s", Now, [A1]) & " Segundos"
Application.OnTime Now + TimeValue("00:00:01"), "Relogio_Segundos"
End Sub

Aprenda Microsoft Excel VBA (SaberExcel)





   Baixe o exemplo de planilha com as macros acima (fazer as configurações)

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