Uygulama TextBox'ta Tarih Formatlı Giriş

Admin

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,097
Puanları
113
Konum
İstanbul
Web sitesi
www.excelarsivi.com
Ad Soyad
Excel Arşivi
Hazırladığınız uygulama veya programlarda TextBox kullanıyor ve bu TextBox'a da bir tarih girişi yapıyorsanız, bu tarih girişini kolaylaştıran kullanışlı bir uygulama örneği eklemek istiyorum.

textboxtarih.gif

Aşağıdaki kodları, UserForm kod penceresine yapıştırıp test edebilirsiniz.

UserForm_Initialize olayı
PHP:
Private Sub UserForm_Initialize()
    On Error Resume Next
    With TextBox1
        .MaxLength = 10
        .EnterFieldBehavior = fmEnterFieldBehaviorRecallSelection
        .Text = "##.##.####"
        .SelStart = 0
        .SelLength = 1
    End With
End Sub
TextBox1_Change olayı
PHP:
Private Sub TextBox1_Change()
    On Error Resume Next
    With TextBox1
        .SelLength = 1
        If .SelText = "." Then
            .SelStart = .SelStart + 1
            .SelLength = 1
        End If
    End With
End Sub
TextBox1_KeyDown olayı..
PHP:
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    On Error GoTo Hata:
    With TextBox1
        If KeyCode = vbKeyLeft Or KeyCode = vbKeyBack Then
            KeyCode = vbKeySelect
            .SelStart = .SelStart - 1
            .SelLength = 1
        ElseIf KeyCode = vbKeyRight Then
            KeyCode = vbKeySelect
            .SelStart = .SelStart + 1
            .SelLength = 1
        ElseIf KeyCode = vbKeyDelete Then
            KeyCode = vbKeySelect
        If .SelText = "." Then
            .SelText = "."
                Else
            .SelText = "#"
        End If
            .SelStart = .SelStart - 1
            .SelLength = 1
        ElseIf KeyCode = vbKeyHome Then
            KeyCode = vbKeySelect
            .SelStart = 0
            .SelLength = 1
        ElseIf KeyCode = vbKeyEnd Then
            KeyCode = vbKeySelect
            .SelStart = Len(TextBox1) - 1
            .SelLength = 1
        End If
    End With
    Exit Sub
Hata:
    KeyCode = vbKeySelect
    TextBox1.SelStart = 0
    TextBox1.SelLength = 1
End Sub
Dosyayı ek'ten indirebilirsiniz.
 

Ekli dosyalar

Üst Alt