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 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
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
Esta macro do Aplicativo Microsoft Excel VBA, pergunta se voce deseja ou não inserir uma planilha
personalizada com o nome formatado com data e hora atual

Sub Adicionar_planilha_com_dia_hora()

Dim Resposta As VbMsgBoxResult
Dim sht As Worksheet
Resposta = MsgBox("Deseja inserir nova planilha com o nome da data e hora atual?" _
, vbQuestion + vbYesNoCancel)
If Resposta = vbYes Then
Set sht = Worksheets.Add
sht.Name = Format(Now, "ddd-dd-mmm-yyyy_hhmmss")
ElseIf Resposta = vbNo Then
Worksheets.Add
Else
Exit Sub
End If
MsgBox "Planilha inserida com sucessso!! [ " & ActiveSheet.Name & "]", vbInformation, "http://www.saberexcel.com"
End Sub

Aplicativo Microsoft Excel VBA --(SaberExcel)--

Calculando Pagamento horas trabalhas no Excel VBA

Qua, 20 de Agosto de 2008 07:11 Administrador

Peço Ajuda:
Preciso de uma macro que calcule horas trabalhadas e me retorne o total do pagamento,
que poderá ser feito também atraves de Uma Entrada de Dados ( InputBox),
Gostaria de saber se podem me ajudar.
Manoel Messias:

Manoel é possível sim, observe essa macro abaixo que retorna o calculo do montante a ser
pagado por horas trabalhadas, isto é, multiplicad o total de horas trabalhadas pelo valor de /
de uma hora


Sub Calcula_Pagamento_Horas_Trabalhadas()
On Error GoTo SbError
Dim vHora
Dim pgHora
Dim iPgto_por_Semana
vHora = InputBox("Entre com o numero de horas trabalhadas", "Horas Trabalhadas")
pgHora = InputBox("Valor do pagamento por hora", "Pagamento valor hora")
iPgto_por_Semana = CCur(vHora * pgHora)
MsgBox "O Pagamento é de : " & Format(iPgto_por_Semana, "R$ ##,##0.00"), , "Total Pagamento"
SbError:
End Sub


Baixe o exemplo de planilha contendo a macro acima