如何在打字时覆盖文本框中的建议文本？

Question

我有使用文本框输入日期的用户表单。

我想在输入之前显示建议文本，例如 __ /__/____（格式相同 dd/mm/yyyy） 输入此文本框时，光标始终在开头。我打字的时候，每个_个符号都会被数字代替，跳过/个符号。

例如：我只输入05041991，在文本框中将显示05/04/1991。

请帮助我了解这段代码。

Answer 1

您可以执行如下所示的操作。此代码只是一个示例（可能并不完美）。

^{图 1：注意只按下了数字键和退格键。}

将以下代码放入class模块中，并命名为MaskedTextBox

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

将以下代码放入您的用户表单

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

    'init TextBox2 as barcode textbox
    Set MaskedTextBox = New MaskedTextBox
    Set MaskedTextBox.mTextBox = Me.TextBox2
    MaskedTextBox.SetMask Mask:="____-____-____", MaskPlaceholder:="_", MaskSeparator:="-", AllowedKeys:=CharacterKeys + NumberKeys
    MaskedTextBoxes.Add MaskedTextBox
End Sub