TextBoxlara Tarih Yazma Kod Yardımı

[Believing]

Sayın Uzman arkadaşlar,

UserForm üzerinde bulunan Frame1 içerisinde 30 adet TextBox bulunmaktadır. TextBox'lara tarih yazarken sadece rakamları (Örnek:24042018) yazmak, ben yazarken aradaki noktalamaları (24.04.2018) otomatik yapmasını sağlamak için aşağıdaki kodlarda nasıl bir değikliğe gitmem gerekir.
Saygılarımla.

Sub tarihler()
Dim cCntrl As Control
Dim tp As Double
Dim lft, wd, hg As Double
tp = 25
wd = 55
hg = 17.8
lft = 118
With Me.Controls("Frame1")
For t = 1 To 15
    For i = 1 To 2
        Set cCntrl = .Add("Forms.textbox.1")
        With cCntrl
        .Width = wd
        .Height = hg
        .Top = tp
        .Left = lft
        .BackColor = &HC0FFFF
        .ForeColor = &HFF&
        .FontSize = 9
        .Font.Bold = False
        .TextAlign = 1
        .Name = "Tarih" & i & "-" & t
        .Text = .Name
        End With
        tp = tp + hg
    Next i
    lft = lft + wd
    tp = 25
Next t
End With
End Sub

Sub Period_Tarihleri_temizle()
For i = 1 To 15
    Me.Controls("Tarih1-" & i).Text = ""
    Me.Controls("Tarih2-" & i).Text = ""
Next
End Sub

 

[alicimri]

Bir class modülle oluşturun, içine aşağıdaki kodu yapıştırın

Public WithEvents txt As MSForms.TextBox
Private Sub txt_Change()
If Len(txt.Value) = 2 Then
txt.Value = txt.Value & "."
End If
If Len(txt.Value) = 5 Then
txt.Value = txt.Value & "."
End If
End Sub

Aşağıdaki kodu ise
User form'un modülüne yapıştırın.

Dim yaz() As New Class1
Private Sub UserForm_Initialize()
Dim cCntrl As Control
Dim tp As Double
Dim lft, wd, hg As Double
tp = 25
wd = 55
hg = 17.8
lft = 118
With Me.Controls("Frame1")
For t = 1 To 15
    For i = 1 To 2
        Set cCntrl = .Add("Forms.textbox.1")
        With cCntrl
        .Width = wd
        .Height = hg
        .Top = tp
        .Left = lft
        .BackColor = &HC0FFFF
        .ForeColor = &HFF&
        .FontSize = 9
        .Font.Bold = False
        .TextAlign = 1
        .Name = "Tarih" & i & "-" & t
        .Text = .Name
        End With
        tp = tp + hg
    Next i
    lft = lft + wd
    tp = 25
Next t
End With

 Dim say As Integer
    Dim ctl As Control
    say = 0
    For Each ctl In Me.Controls
        If TypeName(ctl) = "TextBox" Then
                say = say + 1
                ReDim Preserve yaz(1 To say)
               Set yaz(say).txt = ctl
End If
    Next ctl
End Sub

 

[derisa963]

Merhaba Birinci Kod Noktaları Koyar 2. Kod ise tarih olup olmadığını kontrol eder.

Private Sub TextBox1_Change()
If form_carifinansal.TextBox1 <> "" Then
If Len(TextBox1) = 2 Then
TextBox1 = Format(TextBox1, "0#"".")
End If
If Len(TextBox1) = 5 Then
TextBox1 = Format(TextBox1, "0#"".""##"".")
End If
If Len(TextBox1) = 10 Then
TextBox1 = Format(TextBox1, "0#"".""##"".""####")
End If
End If
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox1.Value <> "" Then
If Not IsDate(TextBox1.Value) Then
MsgBox "Hatalı Tarih Girişi, Tarih Olarak Bugün Ayarlandı.", vbCritical
Cancel = True
TextBox1.Value = Date
End If
End If
End Sub

 

[derisa963]

Sayın Uzman arkadaşlar,

UserForm üzerinde bulunan Frame1 içerisinde 30 adet TextBox bulunmaktadır. TextBox'lara tarih yazarken sadece rakamları (Örnek:24042018) yazmak, ben yazarken aradaki noktalamaları (24.04.2018) otomatik yapmasını sağlamak için aşağıdaki kodlarda nasıl bir değikliğe gitmem gerekir.
Saygılarımla.

Merhaba Birinci Kod Noktaları Koyar 2. Kod ise tarih olup olmadığını kontrol eder.

Private Sub TextBox1_Change()
If form_carifinansal.TextBox1 <> "" Then
If Len(TextBox1) = 2 Then
TextBox1 = Format(TextBox1, "0#"".")
End If
If Len(TextBox1) = 5 Then
TextBox1 = Format(TextBox1, "0#"".""##"".")
End If
If Len(TextBox1) = 10 Then
TextBox1 = Format(TextBox1, "0#"".""##"".""####")
End If
End If
End Sub
'
'İKİNCİ KOD
'
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox1.Value <> "" Then
If Not IsDate(TextBox1.Value) Then
MsgBox "Hatalı Tarih Girişi, Tarih Olarak Bugün Ayarlandı.", vbCritical
Cancel = True
TextBox1.Value = Date
End If
End If
End Sub

 

[alicimri]

Sn. derisa963
Arkadaşın kodları 30 adet TextBox'ı çalışma anında oluşturuyor.

 

[Believing]

Sayın Ali bey,

Konuya gösterdiğiniz ilgi ve yardım için çok teşekkür ederim.

Saygılarımla,