Номера VBA только в текстовом поле

Question

Я пытаюсь получить текстовое поле в пользовательской форме, чтобы принимать только числовой ввод. Либо пользовательский ввод, либо вставка ввода. Если пользователь вставляет значение вроде «9781292098814 paperback» или «9781292098814 онлайн», мне нужно, чтобы этот текст был удален непосредственно перед вводом Excel.

Я пробую 2 кода ниже, но один работает только тогда, когда пользователь вводит данные, используя клавиатуры. Еще один, текст будет удален только после ввода введите Excel.

''remove text for ISBN column
    tmpStr = ISBNTextBox.Value

    For i = 1 To Len(tmpStr)
        Select Case Mid$(tmpStr, i, 1) '//examine current char
            Case "0" To "9" '//permitted chars
               '//ok
            Case Else
               Mid$(tmpStr, i, 1) = "!"
        End Select
    Next i
    tmpStr = Replace$(tmpStr, "!", "") '//strip invalids & return

Еще один

Private Sub ISBNTextBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Select Case KeyAscii
        Case vbKey0 To vbKey9, vbKeyBack, vbKeyClear, vbKeyDelete, _
        vbKeyLeft, vbKeyRight, vbKeyUp, vbKeyDown, vbKeyTab
            If KeyAscii = 46 Then If InStr(1, ISBNTextBox.Text, ".") Then KeyAscii = 0
        Case Else
            KeyAscii = 0
            Beep
    End Select
End Sub

Answer 1

Вы можете повторно проверять строку при каждом изменении. Это будет работать в качестве ключа или вставки

Этот код автоматически удаляет недопустимые символы. Вы можете предпринять другие действия, если вы будете sh

Private Sub TextBox1_Change()
    Dim i As Long, AsEntered As String, Validated As String
    On Error GoTo EH
    If IsNumeric(TextBox1.Value) Then
    Else
        Application.EnableEvents = False
        AsEntered = TextBox1.Value
        For i = 1 To Len(AsEntered)
            If Mid$(AsEntered, i, 1) Like "[0-9]" Then
                Validated = Validated & Mid$(AsEntered, i, 1)
            End If
        Next
        TextBox1 = Validated
    End If
EH:
    Application.EnableEvents = False
End Sub

Answer 2

Примечание : Если вы не хотите обрабатывать десятичные дроби, тогда go с ответом Криса.

Некоторые сценарии ios, которые также будут обрабатывать десятичные дроби

1. TextBox имеет 1234. Курсор после 4. Пользователь пытается вставить sid1.2sid1.2. текстовое поле будет иметь вывод 12341.212
2. TextBox имеет 1234. Курсор после 3. Пользователь пытается вставить sid1.2sid1.2. текстовое поле будет иметь вывод 1231.2124
3. TextBox имеет 1234.56. Курсор после 6. Пользователь пытается вставить sid1.2sid1.2. текстовое поле будет иметь вывод 1231.561212
4. TextBox имеет 1234.56. Курсор после 5. Пользователь пытается вставить sid1.2sid1.2. текстовое поле будет иметь вывод 1231.512126

Поскольку у вас есть десятичные дроби, и вы также хотите перехватить вставку, вы можете попробовать это

Option Explicit

Dim TextPasted As Boolean

'~~> Allow only number and decimal
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Select Case KeyAscii
        Case vbKey0 To vbKey9, vbKeyBack, vbKeyClear, vbKeyDelete, _
        vbKeyLeft, vbKeyRight, vbKeyUp, vbKeyDown, vbKeyTab
            If KeyAscii = 46 Then If InStr(1, TextBox1.Text, ".") Then KeyAscii = 0
        Case Else
            KeyAscii = 0
            Beep
    End Select
End Sub

'~~> Trap the paste event (Ctrl + V, Shift Insert)
Private Sub TextBox1_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, _
ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, _
ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, _
ByVal Shift As Integer)
    TextPasted = True '<~~ Text is pasted
    Cancel = True     '<~~ Cancel paste
    TextBox1_Change   '<~~ Call the change events
End Sub

'~~> Handle TextBox Change Events when we specifically want it
'~~> For example after pasting
Private Sub TextBox1_Change()
    Dim myString As String

    If TextPasted = True Then
        On Error GoTo Whoa

        Application.EnableEvents = False

        Dim DataObj As MSForms.DataObject
        Set DataObj = New MSForms.DataObject

        DataObj.GetFromClipboard
        myString = DataObj.GetText(1) '<~~ Get the copied string from clipboard
        myString = CleanText(myString) '<~~ Clean the string

        '<~~ Output the clean string at cursor position
        TextBox1.SelText = myString
        TextPasted = False
    End If
Whoa:
    Application.EnableEvents = True
End Sub

'~~> Function to extract numbers/decimal from String
Function CleanText(strIn As String) As String
    Dim objRegex
    Dim tempString As String
    Dim i As Long

    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        .Global = True

        '~~> Check if the textbox already has a decimal
        If InStr(1, TextBox1.Text, ".") And TextBox1.SelLength <> Len(TextBox1.Text) Then
            .Pattern = "[^\d]+"
        Else
            .Pattern = "[^0-9.]+"
        End If

        tempString = .Replace(strIn, vbNullString)

        If InStr(1, tempString, ".") Then
            Dim MyAr As Variant

            MyAr = Split(tempString, ".")

            tempString = MyAr(0) & "." & MyAr(1)

            If UBound(MyAr) > 1 Then
                For i = 2 To UBound(MyAr)
                    tempString = tempString & MyAr(i)
                Next i
            End If
        End If
    End With

    CleanText = tempString
End Function

Answer 3

"Я пытаюсь получить текстовое поле в пользовательской форме, чтобы принимать только числовой ввод"

Попробуйте выполнить следующие действия для целых чисел:

Private Sub TextBox1_Change()

Dim RegEx As Object: Set RegEx = CreateObject("VBScript.RegExp")

RegEx.Pattern = "[^\d*]"
RegEx.Global = True
TextBox1.Value = RegEx.Replace(TextBox1.Value, "")

End Sub

Это немедленно удалит все не-цифры из строки. Однако, если (случайно) есть несколько допустимых строк в одном вставленном значении (например: "9781292098814 paperback 9781292098814"), это приведет к нежелательной конкатенации. Если это было бы возможно для ваших пользователей, вы, возможно, захотите подойти к этому по-другому, и вместо RegEx.Replace мы хотим .Test и .Execute вернуть первое действительное значение ISBN:

Private Sub TextBox1_Change()

Dim RegEx As Object: Set RegEx = CreateObject("VBScript.RegExp")

RegEx.Pattern = "\d{1,13}"
RegEx.Global = True
If RegEx.Test(TextBox1.Value) = True Then
    TextBox1.Value = RegEx.Execute(TextBox1.Value)(0)
Else
    TextBox1.Value = ""
End If

End Sub

В приведенном выше случае .Pattern будет разрешать цифры от 1 до 13 раз. Измените его на любую длину, которую вы хотите, чтобы ваш ISBN равнялся go (но не изменяйте 1, чтобы разрешить ввод с клавиатуры).