كتابة التاريخ في التيكست بوكس ولكن؟؟

بعد التحية والسلام

هذا كود لكتابة ( التاريخ فقط ) في التيكست بوكس اخذته من احد المواقع وعدلته بحيث يسمح بكتابة اليوم فالشهر فالسنة عكس مما كان عليه .. بس مشكلتي معاه انه ما يقبل يشتغل مع المصفوفه

يعني لو عندك Text مصفوفه ما راح يشتغل معاها

ارجو من احد الاخوان تعديله بحيث يقبل العمل مع المصفوفات

واحترامي للمنتدى الرائع .. اداره واعضاء

الكود كالتالي

Option Explicit
Private ghSelStart As Integer

Public Enum ghRestrictTypes
    ghDate = 0
End Enum

Dim WithEvents m_ThisTB As TextBox
Private m_ThisType As ghRestrictTypes

Private Sub TBRestrict(KeyAscii As Integer)
On Error Resume Next
  Dim OrigLen As Integer
  Dim sText   As String
  Dim sTextBefore As String
  Dim sTextAfter As String
  Dim AsciiValue As Integer

sTextBefore = Mid(m_ThisTB.Text, 1, ghSelStart)
sTextAfter = Mid(m_ThisTB.Text, ghSelStart + m_ThisTB.SelLength + 1)
    If m_ThisType = ghDate Then
        OrigLen = ghSelStart
        sText = sTextBefore & Chr(KeyAscii)
    Else
        OrigLen = Len(m_ThisTB.Text) - m_ThisTB.SelLength
        sText = sTextBefore & Chr(KeyAscii) & sTextAfter
    End If

    AsciiValue = KeyAscii
    KeyAscii = 0
        
If m_ThisType = ghDate Then
    Select Case AsciiValue
    Case 47
        If Len(sText) = 2 And Mid(sText, 1, 1) <> "0" And ghSelStart = 1 Then
            sText = "0" & sText
            m_ThisTB.Text = sText
            m_ThisTB.SelStart = Len(sText)
        ElseIf Len(sText) = 3 And ghSelStart = 2 Then
            m_ThisTB.Text = sText
            m_ThisTB.SelStart = Len(sText)
        ElseIf Len(sText) = 5 And Mid(sText, 4, 1) <> "0" Then
            sText = Mid(sText, 1, 3) & "0" & Mid(sText, 4)
            m_ThisTB.Text = sText
            m_ThisTB.SelStart = Len(sText)
        ElseIf Len(sText) = 6 Then
            m_ThisTB.Text = sText
            m_ThisTB.SelStart = Len(sText)
        End If
    Case 48 To 57
'(can't be higher than 32)
        If Len(sText) = 4 Then
            If Val(Mid(sText, 4, 1)) > 1 Then
                sText = Mid(sText, 1, 3) & "0" & Mid(sText, 4) & "/"
                m_ThisTB.Text = sText
                m_ThisTB.SelStart = Len(sText)
            Else
                m_ThisTB.Text = sText
                m_ThisTB.SelStart = Len(sText)
            End If
'(can't be higher than 32)
                ElseIf Len(sText) = 5 Then
                    If Val(Mid(sText, 4, 2)) <= 12 Then
                        sText = sText & "/"
                        m_ThisTB.Text = sText
                        m_ThisTB.SelStart = Len(sText)
                    ElseIf Val(Mid(sText, 5, 2)) < 3 Then
                        sText = sText & "/"
                        m_ThisTB.Text = sText
                        m_ThisTB.SelStart = Len(sText)
                    End If
'(can't be higher than 12)
                ElseIf Len(sText) = 1 Then
                    If Val(sText) > 3 Then
                        sText = "0" & Mid(sText, 1, 3) & "/"
                        m_ThisTB.Text = sText
                        m_ThisTB.SelStart = Len(sText)
                    ElseIf Val(Mid(sText, 4, 1)) >= 0 Then
                        m_ThisTB.Text = sText
                        m_ThisTB.SelStart = Len(sText)
                    End If
'(can't be higher than 12)
                ElseIf Len(sText) = 2 Then
                    If Val(Mid(sText, 1, 1)) = 0 Then
                        If AsciiValue <> 48 Then
                            sText = sText & "/"
                            m_ThisTB.Text = sText
                            m_ThisTB.SelStart = Len(sText)
                        End If
                    ElseIf Val(Mid(sText, 1, 2)) <= 32 Then
                        sText = sText & "/"
                        m_ThisTB.Text = sText
                        m_ThisTB.SelStart = Len(sText)
                    End If
                ElseIf Len(sText) > 6 And Len(sText) < 10 Then
                    m_ThisTB.Text = sText
                    m_ThisTB.SelStart = Len(sText)
'The only thing I didn't allow in the years was a 0000 value
                ElseIf Len(sText) = 10 Then
                    If Val(Mid(sText, 7)) > 0 And ghSelStart >= 6 Then
                        m_ThisTB.Text = sText
                        m_ThisTB.SelStart = Len(sText)
                    ElseIf ghSelStart = 0 Then
                        If Val(Mid(sText, 2, 1)) > 2 Or (Val(Mid(sText, 2, 1)) > 0 And Val(Mid(sText, 1, 1)) > 1) Then
                            sText = m_ThisTB.Text
                        End If
                        m_ThisTB.Text = sText
                        m_ThisTB.SelStart = Len(sText)
                    End If
                End If
        End Select
End If
End Sub

Private Sub m_ThisTB_LostFocus()
    Select Case m_ThisType
        Case ghDate
            If Len(m_ThisTB.Text) < 7 Then
                m_ThisTB.Text = ""
           'If the date is 7 chars long (01/01/5), enter (01/01/2005)
            ElseIf Len(m_ThisTB.Text) = 7 Then
                m_ThisTB.Text = Mid(m_ThisTB.Text, 1, Len(m_ThisTB.Text) - 1) & "200" & Right(m_ThisTB.Text, 1)
            ElseIf Len(m_ThisTB.Text) = 8 Then
               'If the date is 8 chars long and the last two are below 90 (01/01/05), enter (01/01/2005)
                If Val(Mid(m_ThisTB.Text, 7)) < 90 Then
                    m_ThisTB.Text = Mid(m_ThisTB.Text, 1, Len(m_ThisTB.Text) - 2) & "20" & Right(m_ThisTB.Text, 2)
               'If the date is 8 chars long and the last two are above 90 (01/01/95), enter (01/01/1995)
                ElseIf Val(Mid(m_ThisTB.Text, 7, 2)) >= 90 Then
                    m_ThisTB.Text = Mid(m_ThisTB.Text, 1, Len(m_ThisTB.Text) - 2) & "19" & Right(m_ThisTB.Text, 2)
                End If
           'If the date is 9 chars long (01/01/200), Maybe they forgot the extra 0? enter (01/01/2000)
            ElseIf Len(m_ThisTB.Text) = 9 Then
                m_ThisTB.Text = m_ThisTB.Text & "0"
            End If
    End Select
End Sub

Private Sub m_ThisTB_KeyDown(Keycode As Integer, Shift As Integer)
    If m_ThisTB.Locked = False And m_ThisType <> ghDate Then
        ghSelStart = m_ThisTB.SelStart
    End If
    If m_ThisType = ghDate Then
        Select Case Keycode
            Case vbKeyLeft, vbKeyUp, vbKeyRight, vbKeyDown
                m_ThisTB.SelLength = 0
            Case Else
                ghSelStart = m_ThisTB.SelStart
        End Select
    End If
End Sub

Private Sub m_ThisTB_KeyPress(KeyAscii As Integer)
    If m_ThisTB.Locked = False And KeyAscii <> vbKeyBack Then
        Call TBRestrict(KeyAscii)
    ElseIf m_ThisTB.Locked = True And KeyAscii = vbKeyBack Then
        m_ThisTB.Text = ""
    End If
End Sub

Public Sub SetTB(ByRef newTB As TextBox, ghRestrictType As ghRestrictTypes)
    Set m_ThisTB = newTB
End Sub

اكتبه في صنف نمطي Cls

بعد كتابته تصرح عنه بالتالي

Private TB As TBDate
Private m_EditType As ghRestrictTypes
Dim WithEvents m_ThisTB As TextBox

وفي حدث تحميل الفورم تكتب التالي

    Set TB = New TBDate

وفي حدث الGotFocus للتيكست المراد منه القبول بكتابة تاريخ فقط تكتب

    TB.SetTB Text2, ghDate