Phạm vi nhập liêu ngày tháng trong TextBox VBA EXCEL

Điều khiển MaskedTextBox cung cấp cơ chế xác thực cho thông tin người dùng nhập vào Biểu mẫu. Ví dụ: nếu bạn muốn TextBox chấp nhận ngày ở định dạng mm / dd / yyyy, bạn có thể đặt mặt nạ trong MaskedTextBox. 

Trong bài viết này, tôi sẽ thảo luận về cách tạo điều khiển MaskedTextBox trong Windows Forms tại thời điểm thiết kế cũng như thời gian chạy. Sau đó, tôi sẽ tiếp tục thảo luận về các thuộc tính và phương thức khác nhau có sẵn cho điều khiển MaskedTextBox. Tạo một MaskedTextBox Chúng ta có thể tạo một điều khiển MaskedTextBox bằng trình thiết kế 

File: 00005 Download

Bước 1 : Tạo 1 CLASSMODEL rồi coppy code dưới vào

Option Explicit

Public WithEvents mTextBox As MSForms.TextBox

Private mMask As String
Private mMaskPlaceholder As String
Private mMaskSeparator As String

Public Enum AllowedKeysEnum
    NumberKeys = 1     '2^0
    CharacterKeys = 2  '2^1
    'for more options next values need to be 2^2, 2^3, 2^4, …
End Enum
Private mAllowedKeys As AllowedKeysEnum

Public Sub SetMask(ByVal Mask As String, ByVal MaskPlaceholder As String, ByVal MaskSeparator As String, Optional ByVal AllowedKeys As AllowedKeysEnum = NumberKeys)
    mMask = Mask
    mMaskPlaceholder = MaskPlaceholder
    mMaskSeparator = MaskSeparator
    mAllowedKeys = AllowedKeys

    mTextBox.Text = mMask
    FixSelection
End Sub


' move selection so separators get not replaced
Private Sub FixSelection()
    With mTextBox
        Dim Sel As Long
        Sel = InStr(1, .Text, mMaskPlaceholder) - 1
        If Sel >= 0 Then
            .SelStart = Sel
            .SelLength = 1
        End If
    End With
End Sub

Private Sub mTextBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim tb As MSForms.TextBox
    Set tb = Me.mTextBox

    'allow paste
    If Shift = 2 And KeyCode = vbKeyV Then
        On Error Resume Next
        Dim DataObj As MSForms.DataObject
        Set DataObj = New MSForms.DataObject

        DataObj.GetFromClipboard
        Dim PasteData As String
        PasteData = DataObj.GetText(1)

        On Error GoTo 0
        If PasteData <> vbNullString Then
            Dim LikeMask As String
            LikeMask = Replace$(mMask, mMaskPlaceholder, "?")

            If PasteData Like LikeMask Then
                mTextBox = PasteData
            End If
        End If
    End If

    Select Case KeyCode
        Case vbKey0 To vbKey9, vbKeyNumpad0 To vbKeyNumpad9
            'allow number keys
            If Not (mAllowedKeys And NumberKeys) = NumberKeys Then
                KeyCode = 0
            ElseIf Len(tb.Text) >= Len(mMask) And InStr(1, tb.Text, mMaskPlaceholder) = 0 Then
                KeyCode = 0
            End If

        Case vbKeyA To vbKeyZ
            'allow character keys
            If Not (mAllowedKeys And CharacterKeys) = CharacterKeys Then
                KeyCode = 0
            ElseIf Len(tb.Text) >= Len(mMask) And InStr(1, tb.Text, mMaskPlaceholder) = 0 Then
                KeyCode = 0
            End If

        Case vbKeyBack
            'allow backspace key
            KeyCode = 0
            If tb.SelStart > 0 Then 'only if not first character
                If Mid$(tb.Text, tb.SelStart, 1) = mMaskSeparator Then
                    'jump over separators
                    tb.SelStart = tb.SelStart - 1
                End If

                'remove character left of selection and fill in mask
                If tb.SelLength <= 1 Then
                    tb.Text = Left$(tb.Text, tb.SelStart - 1) & Mid$(mMask, tb.SelStart, 1) & Right$(tb.Text, Len(tb.Text) - tb.SelStart)
                End If
            End If

            'if whole value is selected replace with mask
            If tb.SelLength = Len(mMask) Then tb.Text = mMask

        Case vbKeyReturn, vbKeyTab, vbKeyEscape
            'allow these keys

        Case Else
            'disallow any other key
            KeyCode = 0
    End Select

    FixSelection
End Sub

Private Sub mTextBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    FixSelection
End Sub

Bước 2 : Gắn code này vào Userform nhớ sữa lại tên textbox nhá

Option Explicit
Private MaskedTextBoxes As Collection
Private Sub UserForm_Initialize()
    Set MaskedTextBoxes = New Collection
    Dim MaskedTextBox As MaskedTextBox
    'init TextBox1 as date textbox
    Set MaskedTextBox = New MaskedTextBox
    Set MaskedTextBox.mTextBox = Me.TextBox1
    MaskedTextBox.SetMask Mask:="__/__/____", MaskPlaceholder:="_", MaskSeparator:="/"
    MaskedTextBoxes.Add MaskedTextBox
End Sub

Chúc các bạn thành công