Пользовательские текстовые поля являются числовыми (и нулевыми)

Я реализую пользовательскую форму и хочу включить некоторые проверки входных данных до запуска пользовательской формы. В частности, проверьте, что все входные данные в текстовые поля пользовательской формы являются числовыми, хотя действительно, текстовое поле пустое или пустое. Я попытался реализовать следующее:

    Select Case KeyAscii
    Case 0, 46, 48 To 57
    Case Else
    MsgBox "Only numbers allowed"
    End Select

Но это не работает. Пожалуйста, идеи? Большое спасибо!!!!!!!!!

Источник

2 ответа

Решение

Может быть, немного затянуто - я обычно использую модуль класса и свойство тега в элементе управления, чтобы решить, что можно ввести в текстовое поле.

Создайте форму с четырьмя текстовыми полями.
Дайте текстовым полям следующие теги:

  • 1; CDbl
  • 2; CINT
  • 3; ПРМ
  • 4;CSENTENCE

Числа - это столбцы для вставки значений при сохранении формы (здесь я не описал этот бит).
Текст описывает, что можно ввести в текстовое поле: CDBL - это число с двумя десятичными знаками, CINT - это число с 0 десятичными знаками, CSTR - для правильного текста, а CSENTENCE - для текста предложения.

Создайте модуль класса с именем clsControlText,
Добавьте этот код в модуль класса:

Public WithEvents txtBox As MSForms.TextBox

Private Sub txtBox_Change()
  Static LastText As String
  Static SecondTime As Boolean
  Const MaxDecimal As Integer = 2
  Const MaxWhole As Integer = 1

  With txtBox
    If InStr(.Tag, ";") > 0 Then
        Select Case Split(.Tag, ";")(1)
            Case "CDBL", "CCur"
                'Allow only numbers with <=2 decimal places
                If Not SecondTime Then
                    If .Text Like "[!0-9.-]*" Or Val(.Text) < -1 Or _
                        .Text Like "*.*.*" Or .Text Like "*." & String$(1 + MaxDecimal, "#") Or _
                        .Text Like "?*[!0-9.]*" Then
                        Beep
                        SecondTime = True
                        .Text = LastText
                    Else
                        LastText = .Text
                    End If
                End If
                SecondTime = False
            Case "CINT"
                'Allow only whole numbers.
                If .Text Like "[!0-9]" Or Val(.Text) < -1 Or .Text Like "?*[!0-9]*" Then
                    Beep
                    .Text = LastText
                Else
                    LastText = .Text
                End If
            Case "CSTR"
                'Convert text to proper case.
                .Text = StrConv(.Text, vbProperCase)
            Case "CSENTENCE"
                'Convert text to sentence case (capital after full-stop).
                .Text = ProperCaps(.Text)
            Case Else
                'Allow anything.
        End Select
    End If
  End With
End Sub

Private Function ProperCaps(strIn As String) As String
    Dim objRegex As Object
    Dim objRegMC As Object
    Dim objRegM As Object
    Set objRegex = CreateObject("vbscript.regexp")
    strIn = LCase$(strIn)
    With objRegex
        .Global = True
        .ignoreCase = True
         .Pattern = "(^|[\.\?\!\r\t]\s?)([a-z])"
        If .Test(strIn) Then
            Set objRegMC = .Execute(strIn)
            For Each objRegM In objRegMC
                Mid$(strIn, objRegM.firstindex + 1, objRegM.Length) = UCase$(objRegM)
            Next
        End If
        ProperCaps = strIn
    End With
End Function

Добавьте этот код в форму пользователя:

Private colTextBoxes As Collection

Private Sub UserForm_Initialize()

    Dim ctrlSelect As clsControlText
    Dim ctrl As Control


    Me.Caption = ThisWorkbook.Name

    Set colTextBoxes = New Collection
    For Each ctrl In Me.Controls
        Select Case TypeName(ctrl)
            Case "TextBox"
                Set ctrlSelect = New clsControlText
                Set ctrlSelect.txtBox = ctrl
                colTextBoxes.Add ctrlSelect
        End Select
    Next ctrl

End Sub

NB: не весь этот код мой. я нашел ProperCaps и код для CDBL в другом месте на этом сайте - или, может быть, MrExcel.

Источник

Вы могли бы использовать базовый LIKE или же Regexp

Sub Test()
Debug.Print StrCheck("")
Debug.Print StrCheck("hello kitty")
Debug.Print StrCheck("4156")
End Sub

функция

Function StrCheck(strIn As String) As String
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Pattern = "\d+"
'vaidate empty string
If Len(Trim(strIn)) = 0 Then
    StrCheck = True
Else
'validate whether non-empty string is numeric
    StrCheck = objRegex.Test(strIn)
End If
End Function
Источник
Другие вопросы по тегам