(12/03/2020, 12:59)feraz yazdı: Özür kabul edildi üstad Biraz acele oldu zamanım kalmadı bir deneyin diyeceğim ama mualla.
Kullanım

Private Sub Komut2_Click()
    If isTarih(Metin0) = False Then
        MsgBox "Hatali"
    Else
        MsgBox "Dogru"
    End If
  
End Sub

Kodu Seç

Kodu Kopyala

Kod;

Private Function isTarih(metinTextbox As TextBox) As Boolean
    
    With metinTextbox
    
    isTarih = False
    
        If .Value = "" Or IsNull(.Value) Then GoTo enson
            Dim tarih As Variant, trh As Date, eom As Long, deger As String

            .Value = Replace(.Value, " ", ".")
            .Value = Replace(.Value, "/", ".")
            tarih = Split(.Value, ".")
          
            If Len(tarih(0)) = 1 Then tarih(0) = "0" & tarih(0)
            If Len(tarih(1)) = 1 Then tarih(1) = "0" & tarih(1)
            deger = tarih(0) & "." & tarih(1) & "." & tarih(2)
          
            If Not deger Like "##.##.####" Then
                isTarih = False
'                MsgBox metinTextbox.Name & " Tarih bilgisi ""gg.aa.yyyy"" þeklinde girilmelidir.", vbCritical, "HATA"
                .SetFocus
                GoTo var
            Else
          
                trh = DateSerial(tarih(2), tarih(1), 1)
                eom = Day(CLng(DateSerial(Year(trh), Month(trh) + 1, 1) - 1))
                If Val(tarih(0)) > eom Then
                    GoTo son
                    .SetFocus
                End If
                If tarih(1) > 12 Then
                  GoTo son
                  .SetFocus
            End If
        End If
        isTarih = True
'        MsgBox metinTextbox.Name & " Tarih Format Dogru...", vbInformation, "Bilgi"
        
var:
    eom = Empty
    trh = Empty
    deger = Empty
    Erase tarih
    Exit Function

son:
  isTarih = False
    eom = Empty
    trh = Empty
    deger = Empty
    Erase tarih
    .SetFocus
'    MsgBox metinTextbox.Name & " Hatali Tarih...", vbCritical, "Hata"
    Cancel = True
enson:
  isTarih = False
    End With

End Function

Kodu Seç

Kodu Kopyala