Prezados:
Utilizo uma macro do excel para digitar as datas sem digitar as barras (“/”).
Caso a data seja digitada com as barras, aparece uma mensagem de erro.
Acontece que qualquer data dentro do período de 29/05/82 a 24/11/1990 (não sei se com outros períodos também acontece) que for digitada com as barras, não dá erro e a mensagem de erro não aparece, e o excel entende a data inserida como um número.
Caso seja desabilitado o “Case 5” da macro, este problema não acontece, mas ai o excel não reconhece as datas que começam com zero.
Teria como resolver este problema?
Encontrei outra macro bem parecida com a que utilizo, mas também acontece o mesmo problema.
MACRO QUE UTILIZO:
Public Sub Worksheet_Change(ByVal Target As Range)
'Função para entrar Datas sem digitar as "/"
Dim DateStr As String, C1, C2
Select Case Target.Cells.Count
Case Is > 1
For Each C1 In Range(Target.Address)
For Each C2 In Range("A1:A25")
If C1.Address = C2.Address Then
If FLAG Then
Selection.Delete
FLAG = Not FLAG
Exit Sub
End If
Exit Sub
End If
Next C2
Next C1
Exit Sub
Case Else
If Application.Intersect(Range(Target.Address), _
Range("A1:A25")) Is Nothing Or _
Target.Value2 = "" Then Exit Sub
End Select
On Error GoTo EndMacro
With Target
If .HasFormula = False Then
Select Case Len(.Formula)
Case 1 'ex: 1 = 00/00/01
DateStr = "01/01/0" & .Formula
Case 2 'ex: 12 = 00/00/12
DateStr = "01/01/" & .Formula
Case 3 'ex: 123 = 00/01/23
DateStr = "01/0" & Left(.Formula, 1) & "/" & Right(.Formula, 2)
Case 4 'ex: 1234 = 00/12/34
DateStr = "01/" & Left(.Formula, 2) & "/" & Right(.Formula, 2)
Case 5 'ex: 12345 = 01/23/45
DateStr = Left(.Formula, 1) & "/" & Mid(.Formula, 2, 2) & "/" & Right(.Formula, 2)
Case 6 'ex: 123456 = 12/34/56
DateStr = Left(.Formula, 2) & "/" & Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 'ex: 1234567 = 12/34/567
DateStr = Left(.Formula, 2) & "/" & Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 8 'ex: 12345678 = 12/34/5678
DateStr = Left(.Formula, 2) & "/" & Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
End Select
Application.EnableEvents = False
.Formula = DateValue(DateStr)
End If
End With
GoTo Fim
EndMacro:
Target.Value = "" 'limpa a célula
Range(Target.Address).Select
MsgBox "As datas deverão ser inseridas no formato ddmmaa, sem as barras.", vbInformation, "DATA INVÁLIDA !!!!!"
Fim:
Application.EnableEvents = True
End Sub
MACRO QUE ENCONTREI NA INTERNET:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim DateStr As String
On Error GoTo EndMacro
If Intersect(Target, Range("A1:A25")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
Application.EnableEvents = False
With Target
If .HasFormula = False Then
Select Case Len(.Formula)
Case 5
DateStr = Left(.Formula, 1) & "/" & Mid(.Formula, 2, 2) & "/" & Right(.Formula, 2)
Case 6
DateStr = Left(.Formula, 2) & "/" & Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case Else
Err.Raise 0
End Select
.Formula = DateValue(DateStr)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "As datas deverão ser inseridas no formato ddmmaa, sem as barras.", vbInformation, "DATA INVÁLIDA !!!!!"
Range(Target.Address).ClearContents
Application.EnableEvents = True
End Sub
Agradeço que puder ajudar.
AdrianoPires
Postado : 09/03/2015 2:51 pm