Tarih formatında uyarı mesajı

[ASLAN7410]

Merhaba arkadaşlar hayırlı çalışmalar.

Ekte gönderdiğim excel sayfamın C3 hücresine tarihin hangi şekli yazılırsa yazılsın, örneğin 14.02.2016 (tarihin aralarında nokta olacak şekilde) tarihinden farklı formatta ise uyarı mesajı versin.

Aşağıdaki kodda yapmaya çalıştım ancak olmadı.
Yardım edecek arkadaşlara şimdiden teşekkür ederim.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 3 And Target.Column = 3 Then
If Range("c3").Text <> "" And Len(Range("c3").Text) <> 10 Then
'If Range("c3").Text <> "" And Format(Now, "dd/mm/yyyy") Then
MsgBox ("Tarihi ") & Format(Now, "dd.mm.yyyy") & (" şeklinde giriniz!.."), vbInformation, "ASLAN"
Range("c3") = ""
End If
End If
'End If
End Sub

 

[Korhan Ayhan]

Sayfanızdaki veri doğrulamaları temizledikten sonra aşağıdaki kodu deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Range("C3"), Target) Is Nothing Then Exit Sub
    If Target.Text = "" Then Exit Sub
    If Not IsNumeric(Target) Then GoTo 10
    If Not Evaluate("=EXACT(" & Target.Text & ",TEXT(" & Target.Text & ",""??.??.????""))") Then
10      MsgBox "Tarihi aşağıdaki görünümde giriniz." & Chr(10) & Chr(10) & _
               Format(Now, "dd.mm.yyyy"), vbInformation, "ASLAN"
        Target = ""
    End If
End Sub

 

[zeugma35]

korhan hocam pekı kullanıcı yanlışlıkla yanlış bi tarih girdiğinde uyarı mesajı verdirebilirmiyiz

örn 01.20.2025 gibi

 

[ASLAN7410]

Bu mesaj silindi

 

[ASLAN7410]

Sayın Korhan Bey ellerinize sağlık, çok teşekkür ediyorum, veri doğrulamaları sonradan gördüm.

Üyelerden zeugma35'in bildirmiş olduğu tarih yanlış girildiğindede mesaj gelebilir mi? Bu aklıma gelmemişti.

Şimdiden teşekkür ederim.

 

[ASLAN7410]

Sayın Korhan Bey aşağıdaki linkte böyle bir çalışmanıza rast geldim, ancak linkteki örnekler TextBox için yapılmış, ayrıca linkteki örnek dosyalar bulunmamaktadır.

Üyelerden zeugma35'in bildirmiş olduğu tarih yanlış girildiğindede mesaj gelebilir mi?
Ayrıca bu kodu başka hücreler içinde kullanmam gerekirse örneğin C3, D3, E3 gibi, C3 hücresi için yazılan bu kodda nereye ekleme yapmam gerekir.

http://www.excel.web.tr/f48/hataly-girilen-tarih-icin-uyary-verilebilirmi-t36301.html

 

[Korhan Ayhan]

Bir kaç ekleme yaptım. Deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Range("C3"), Target) Is Nothing Then Exit Sub
    On Error GoTo 10
    If Target.Text = "" Then Exit Sub
    If Not IsNumeric(Target) Then GoTo 10
    If Not IsDate(Target) Then GoTo 10
    If Left(Target, 2) > 31 Then GoTo 10
    If Mid(Target, 4, 2) > 12 Then GoTo 10
    If Not Evaluate("=EXACT(""" & Target.Text & """,TEXT(""" & Target.Text & """,""??.??.????""))") Then
10      MsgBox "Tarihi aşağıdaki görünümde giriniz." & Chr(10) & Chr(10) & _
               Format(Now, "dd.mm.yyyy"), vbInformation, "ASLAN"
        Target = ""
    End If
End Sub

 

[zeugma35]

hocam ben bu kodları kullanıyorum verdiğinizz kodları uyarlamaya çalıştım ama olmadı

yanlış bir tarih girdiğinde hata vermesi için aşağıdaki kodlara nasıl bir uyarlama yapabiliriz

Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If KeyAscii = 46 Then Exit Sub
    If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0: MsgBox "     Sadece Rakam Giriniz .....    "
    
End Sub

Private Sub TextBox3_Change()
If Len(TextBox3) = 2 Then TextBox3.Text = TextBox3.Text & "."
If Len(TextBox3) = 5 Then TextBox3.Text = TextBox3.Text & "."
If Len(TextBox3) = 10 Then TextBox3.SetFocus
TextBox3.MaxLength = 10
End Sub

 

[Korhan Ayhan]

Önerdiğim kod excel sayfasının arka planında çalışan kodlardır. Userform için forumda daha farklı örnekler var. Arama yaparsanız ulaşabilirsiniz.

 

[ASLAN7410]

Sayın Korhan Bey ilginiz için çok teşekkür ederim, ellerinize sağlık kod gayet güzel çalışıyor Allah razı olsun.

Ayrıca bu kodu başka hücreler içinde uyarlamaya çalıştım olmadı, örneğin C3-D3-E3 ve F3 hücreler için de yapmak istiyorum.

 

[ASLAN7410]

Sayın Korhan Bey kodun başlık kısımını aşağıdaki gibi yapıyorum, hata veriyor.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Range("C3", "D3", "E3", "F3"), Target) Is Nothing Then Exit Sub

 

[Korhan Ayhan]

Aşağıdaki gibi deneyiniz.

If Intersect(Range("C3:F3"), Target) Is Nothing Then Exit Sub

 

[ASLAN7410]

Sayın Korhan Bey vardiyalı çalıştığım için bilgisayar başına yeni geçebildim.

Tam istediğim gibi oldu, ellerinize sağlık çok teşekkür ederim, hayırlı çalışmalar.