Macro Excel para substituir vírgula por dois pontos

WESLEYARODRIGUES · 13 de dezembro de 2012

Bom dia pessoal, tenho uma planilha para calcular hora extra e preciso criar uma macro que substitua a vírgula "," do teclado numérico por dois pontos ":" no momento da digitação. Consegui o código abaixo em outro fórum, porém ele me deu um trabalhão...rsrs.

Private Sub Workbook_Activate()

Application.AutoCorrect.AddReplacement What:=",", Replacement:=":"

Application.AutoCorrect.ReplaceText = True

ActiveWorkbook.Date1904 = True

End Sub

Private Sub Workbook_Deactivate()

Application.AutoCorrect.DeleteReplacement What:=","

Application.AutoCorrect.ReplaceText = False

ActiveWorkbook.Date1904 = False

End Sub

Ele realmente troca a vírgula por dois pontos, porém ficou fazendo isso para todas as planilhas novas que eu abria. Assim, gostaria de um código parecido, porém que só ficasse habilitado no momento que eu marcasse uma checkbox, e só na planilha de horas mesmo.

Patropi · 13 de dezembro de 2012

Bom dia Wesley

Em vez de digitar a vígula e depois substituir por dois pontos, fica mais fácil, digitar sem a vírgula e usar uma macro para colocar os dois pontos automaticamente.

Coloque este código no Módulo da Planilha:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim TimeStr As String
On Error GoTo EndMacro
If Application.Intersect(Target, Range("B8:B13")) 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

Faça adaptação do intervalo da macro para o intervalo da tua planilha.

Um abraço.

WESLEYARODRIGUES · 13 de dezembro de 2012

Bom dia Wesley

Em vez de digitar a vígula e depois substituir por dois pontos, fica mais fácil, digitar sem a vírgula e usar uma macro para colocar os dois pontos automaticamente.

Coloque este código no Módulo da Planilha:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim TimeStr As String
On Error GoTo EndMacro
If Application.Intersect(Target, Range("B8:B13")) 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

Faça adaptação do intervalo da macro para o intervalo da tua planilha.

Um abraço.

Bom dia Patropi,

Copiei o código, alterei o intervalo corretamente, porém não está dando certo.

Qualquer valor que eu digito sem dois pontos ou vírgula, torna-se 0:00.

deejaywesley · 13 de dezembro de 2012

Bom Dia xara rsrsrs

onde você esta colocando o codigo?

porque testei o codigo o amigo Patropi e está funcionando blzinha!

deve ser o lugar que você ta arrumando...

você coloca ele na parte na planilha mesmo Plan1 ou Plan2 e nao na parte

de estapastadetrabalho e nao em modulos tbem!

WESLEYARODRIGUES · 13 de dezembro de 2012

Bom Dia xara rsrsrs
onde você esta colocando o codigo?

porque testei o codigo o amigo Patropi e está funcionando blzinha!

deve ser o lugar que você ta arrumando...

você coloca ele na parte na planilha mesmo Plan1 ou Plan2 e nao na parte

de estapastadetrabalho e nao em modulos tbem!

E aí xará beleza?...rsrs

Incluí o código onde você falou e agora deu certo... valeu mesmo!

Havia entendido que era pra colocar no módulo, por isso não funcionou.

Obrigado a você e ao Patropi!!!