- Katılım
- 25 May 2018
- Mesajlar
- 1,558
- En iyi yanıt
- 14
- Puanları
- 113
- Konum
- İstanbul
- Web sitesi
- excelarsivi.com
- Ad Soyad
- Murat OSMA
- Office Vers.
- Office 365 TR+EN
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 textboxtarih.gif](https://excelturkey.com/data/attachments/0/201-7d2dbe532d8701582245583e3b210444.jpg)
Aşağıdaki kodları, UserForm kod penceresine yapıştırıp test edebilirsiniz.
UserForm_Initialize olayı
TextBox1_Change olayı
TextBox1_KeyDown olayı..
Dosyayı ek'ten indirebilirsiniz.
![textboxtarih.gif textboxtarih.gif](https://excelturkey.com/data/attachments/0/201-7d2dbe532d8701582245583e3b210444.jpg)
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
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
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.