Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Digitar horas sem o...
 
Notifications
Clear all

Digitar horas sem os dois pontos

 
2024 - VBA & Macros
Post Recente por diego_moreira 12 anos atrás
8 Posts
3 Usuários
0 Reactions
5,699 Visualizações
RSS
 Charlie-81
(@charlie-81)
Posts: 290
Reputable Member
Topic starter
 

Olá...

Salve salve

Encontrei na net o código abaixo que permite que eu digite horas sem os 2 pontos e que continua tratando o número como horas mesmo, possibilitando que eu some essas horas. O código me atende em grande parte no que faço, porém, quando informo horas superiores a 24:00 ele me retorna o valor de 0:00. Se digito 27:00 que seriam 3:00 da manhã, o código me retorna 0:00. Queria saber se existe como adaptá-lo para que quando eu digite horas acima de 24:00 ele me mostre o horário correto. Outra coisa, quando o formato das horas estão no formato padrão, ao digitar 27:00, ele me retorna automaticamente para 03:00, mostrando assim o horário real.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim TimeStr As String
On Error GoTo EndMacro
If Application.Intersect(Target, Range("A1:Z1000")) Is Nothing Then
Exit Sub
End If
If Target.Cells.Count > 1 Then
Exit Sub
End If
If Target.Value = "" Then
Exit Sub
End If
Application.EnableEvents = False
With Target
If .HasFormula = False Then
Select Case Len(.Value)
Case 1 ' e.g., 1 = 00:01 AM
TimeStr = "00:0" & .Value
Case 2 ' e.g., 12 = 00:12 AM
TimeStr = "00:" & .Value
Case 3 ' e.g., 735 = 7:35 AM
TimeStr = Left(.Value, 1) & ":" & _
Right(.Value, 2)
Case 4 ' e.g., 1234 = 12:34
TimeStr = Left(.Value, 2) & ":" & _
Right(.Value, 2)
Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
TimeStr = Left(.Value, 1) & ":" & _
Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
Case 6 ' e.g., 123456 = 12:34:56
TimeStr = Left(.Value, 2) & ":" & _
Mid(.Value, 3, 2) & ":" & Right(.Value, 2)
Case Else
Err.Raise 0
End Select
.Value = TimeValue(TimeStr)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "Digite a hora sem os pontos"
Application.EnableEvents = True
End sub
 
Postado : 14/06/2012 10:07 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Este tópico deveria ser postado em PROGRAMAÇÃO.
Vou move-lo!!

Att

 
Postado : 14/06/2012 11:38 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!
vá em formatar células>personalizar> e coloque:
00":"00
Ps.não sei como são feitos os seus cálculos, mas para somar e subtrair comigo funfa..

Boa sorte!!

 
Postado : 14/06/2012 7:39 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Eu utilizo o codigo abaixo, funciona bem, inclusive para valores superiores |à 24hs

Private Sub Worksheet_Change(ByVal Target As Range)
Dim HoraDigitada As String
Dim HoraFormatada As String
Dim Tamanho As Integer
Dim Retorno
Dim Endereço

If Target.HasFormula Then
       Exit Sub
End If

If IsNumeric(Target.Value) = False Then
       Exit Sub
End If
On Error Resume Next
Application.EnableEvents = False
HoraDigitada = Target.Value

Tamanho = Len(HoraDigitada)
If Tamanho = 1 Then
       HoraDigitada = "000" & HoraDigitada
ElseIf Tamanho = 2 Then
       HoraDigitada = "00" & HoraDigitada
End If
HoraFormatada = Left(HoraDigitada, Len(HoraDigitada) - 2) & ":" & Right(HoraDigitada, 2)

Target = HoraFormatada
Application.EnableEvents = True
On Error GoTo 0

End Sub
 
Postado : 15/06/2012 6:54 am
 Charlie-81
(@charlie-81)
Posts: 290
Reputable Member
Topic starter
 

Para mim já pode ser encerrado o tópico. O Reinaldo matou a charada.

 
Postado : 15/06/2012 7:02 am
 diego_moreira
(@diego_moreira)
Posts: 7
Active Member
 

Eu utilizo o codigo abaixo, funciona bem, inclusive para valores superiores |à 24hs

Private Sub Worksheet_Change(ByVal Target As Range)
Dim HoraDigitada As String
Dim HoraFormatada As String
Dim Tamanho As Integer
Dim Retorno
Dim Endereço

If Target.HasFormula Then
       Exit Sub
End If

If IsNumeric(Target.Value) = False Then
       Exit Sub
End If
On Error Resume Next
Application.EnableEvents = False
HoraDigitada = Target.Value

Tamanho = Len(HoraDigitada)
If Tamanho = 1 Then
       HoraDigitada = "000" & HoraDigitada
ElseIf Tamanho = 2 Then
       HoraDigitada = "00" & HoraDigitada
End If
HoraFormatada = Left(HoraDigitada, Len(HoraDigitada) - 2) & ":" & Right(HoraDigitada, 2)

Target = HoraFormatada
Application.EnableEvents = True
On Error GoTo 0

End Sub

Reinaldo, eu testei o código que você postou, e percebi que ele não mostra os segundos. Tem como ajustar para mostrar os segundos?

 
Postado : 21/06/2012 10:05 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Veja se atende

Private Sub Worksheet_Change(ByVal Target As Range)
'Codigo original por José Luiz Martins, adaptação por Reinaldo
Dim HoraDigitada As String
Dim HoraFormatada As String
Dim Tamanho As String
Dim Retorno
Dim Endereço

If Target.HasFormula Then
       Exit Sub
End If

If IsNumeric(Target.Value) = False Then
       Exit Sub
End If
On Error Resume Next
Application.EnableEvents = False
HoraDigitada = Target.Value

    Select Case Len(HoraDigitada)
        Case 1 To 2 ' ex: 12 = 12:00:00
                    Tamanho = "00:00" & ":" & HoraDigitada
                Case 3 ' ex:, 735 = 00:07:35
                    Tamanho = "00:0" & Left(HoraDigitada, 1) & ":" & Right(HoraDigitada, 2)
                Case 4 ' ex:, 1234 = 12:34
                    Tamanho = "00:" & Left(HoraDigitada, 2) & ":" & Right(HoraDigitada, 2)
                Case 5 ' ex:, 12345 = 1:23:45 e não 12:03:45
                    Tamanho = Left(HoraDigitada, 1) & ":" & _
                        Mid(HoraDigitada, 2, 2) & ":" & Right(HoraDigitada, 2)
                Case 6 ' ex:, 123456 = 12:34:56
                    Tamanho = Left(HoraDigitada, 2) & ":" & _
                        Mid(HoraDigitada, 3, 2) & ":" & Right(HoraDigitada, 2)
                Case Else
                    Err.Raise 0
            End Select

Target = Tamanho
Application.EnableEvents = True
End Sub
 
Postado : 21/06/2012 11:23 am
 diego_moreira
(@diego_moreira)
Posts: 7
Active Member
 

Funcionou perfeitamente

Muito obrigado

 
Postado : 24/06/2012 6:26 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico