Excel 如何在键入时覆盖文本框中的建议文本？

我使用文本框输入日期

我想在输入之前显示建议文本，如

\uuuu/\uuuuu/\uuuuuuu

（相同格式

dd/mm/yyyy

） 输入此文本框时，光标始终位于开头。当我输入时，每个

\u

符号将被数字替换，并跳过

/

符号

例如：我只需键入

05041991

，在文本框中将显示

05/04/1991

请帮我查一下这个代码

---

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

图1：请注意，只按了数字键和退格键

将以下代码放入类模块中，并将其命名为

MaskedTextBox

---

将替换文本的逻辑放入

专用子文本框1u KeyPress（ByVal keyscii作为MSForms.ReturnInteger）

…此事件捕获文本框中按下的键。这只是一个示例。我对条形码句柄输入也有同样的问题，比如12个数字字符需要输入到文本框中，建议文本为

1xxx xxxx xxxx

我建议使用日期：）您可以编写一个字符串格式化程序，读取字符串，删除所有非数字，并在适当的位置用破折号将其吐出。然后将其写回文本字段，并将光标位置设置为它所在的位置。在每个textBox\u Change事件上都这样做。@HaiNguyen我改进了代码并将其包装到类模块中。看一看。我还将您的代码修改为另一个案例，如仅带数字的

1\uuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu。但你们能帮我在文本框中允许粘贴（Ctrl+V）功能吗？谢谢。@HaiNguyen我添加了一些代码来允许粘贴（Ctrl+V），它可以完美地工作。但我有更多的请求：1-在最后一个数字中，例如：103456789012，在我键入“2”后，它会自动
vbTab
更改到下一个对象。2-如果我离开文本框时没有完整的数字（有几个
。
），它会将背景色更改为
vbRed
@HaiNguyen这不是免费的编码服务。你必须试着自己做到这一点（如果你陷入困境或犯了错误，可以问一个新问题，展示你所做的尝试）。根据您的需要更改课堂模块。
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