Question

所以我有一些基本的VBA代码：

Sub Test()
    ' Set error handler
    On Error GoTo ErrorHandler

    Dim strElevation As String
    strElevation = InputBox("Enter elevation difference:", "Create Cross Lines", 0.5)

    Exit Sub

ErrorHandler:
    Call ReportError("Test")
End Sub

它看起来很好：

是否可以对此进行扩展，以便编辑框只允许数字值为2位小数？或者这只是太多的工作？

我知道如何格式化文本本身，例如：Format("1234.5678", "#.00")。但实际的编辑控件本身可以进行任何自定义吗？

Answer 1

你基本上有三个选择......按顺序排列：

<强> 1。验证输入

这使用了您在上面的代码示例中的原生InputBox()函数。您可以将值返回到字符串变量中，然后在该点进行验证，以确保数据的格式符合您的要求。如果它没有通过，则再次显示输入框。

<强> 2。自定义VBA表单

如果您创建自己的VBA用户表单，则可以自定义文本框以使用特定格式，并在表单接受输入并关闭之前执行验证。这可能是最用户友好的方法，但涉及的代码比第一种方法多一点。

示例：的

使用两个输入框和一个命令按钮创建示例VBA表单。分别为txtDiff1，txtDiff2和cmdOK命名。

双击其中一个控件，并将以下代码添加到表单后面的代码模块中：

Option Explicit

Private Sub cmdOK_Click()
    MyElevationDifference = txtDiff1 ' (or txtDiff2)
    Unload Me
End Sub

Private Sub txtDiff1_AfterUpdate()

    Dim dblValue As Double

    If IsNumeric(txtDiff1) Then
        ' Determine rounded amount
        dblValue = Round(txtDiff1, 2)
        ' Automatically round the value
        If dblValue <> CDbl(txtDiff1) Then txtDiff1 = dblValue
    Else
        MsgBox "Please enter a numeric value", vbExclamation
    End If

End Sub


Private Sub txtDiff2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

    Dim dblValue As Double

    If IsNumeric(txtDiff2) Then
        ' Determine rounded amount
        dblValue = Round(txtDiff2, 2)
        ' Require a max of 2 decimal places
        If dblValue <> CDbl(txtDiff2) Then
            Cancel = True
            MsgBox "Please only use 2 decimal places", vbExclamation
        End If
    Else
        MsgBox "Please enter a numeric value", vbExclamation
        ' Cancel change
        Cancel = True
    End If

End Sub

将以下内容粘贴到常规代码模块中。（这是通过自定义表单在主代码中获取输入的方法。本质上，表单为全局变量赋值，并在显示表单后引用它。）

Option Explicit

Public MyElevationDifference As Double

Public Sub GetElevationDifference()
    UserForm1.Show
    MsgBox "Elevation difference: " & MyElevationDifference, vbInformation
End Sub

现在，当您运行GetElevationDifference()时，您会在用户表单上看到几种不同的方法。 第一个文本框会自动 围绕输入，而第二个文本框会不允许用户继续，除非他们更正输入以使用两位小数或更少。

当然，您需要添加一些错误处理并使表单看起来不错，但这为您提供了一个如何使用VBA表单来获取用户输入的简单示例。它们涉及更多的代码，但显然比简单的InputBox()函数提供了更大的灵活性。

第3。 Windows API调用

为了完整起见，有一些方法可以使用Windows API调用来实际影响输入框上的控件，但这最终会比前两种方法复杂得多，我不建议像这样的东西

Answer 2

这是你可以限制输入框以仅允许数值的方法：

strElevation = Application.InputBox(prompt:="Enter elevation difference:", Title:="Create Cross Lines", Default:=0.5, Type:=1)

https://msdn.microsoft.com/en-us/vba/excel-vba/articles/application-inputbox-method-excel

要验证长度，您可以使用以下代码：

Do
  strElevation = Application.InputBox(prompt:="Enter elevation difference:", Title:="Create Cross Lines", Default:=0.5, Type:=1)

  If Len(strElevation) > 2 Then MsgBox "You typed in too many characters... 2 maximum!"
Loop While Len(strElevation) > 2

Answer 3

Private Sub TextBox1_AfterUpdate()
    If InStr(1, Me.TextBox1.Value, ".") > 0 Then
        If Len(Mid(Me.TextBox1.Value, _
            InStr(1, Me.TextBox1.Value, "."), _
            Len(Me.TextBox1.Value) - InStr(1, Me.TextBox1.Value, "."))) > 2 Then
            Me.TextBox1.SetFocus
            MsgBox "cannot have more than 2 decimal places"
        End If
    End If
End Sub

适用于您的情况，但这可以帮助您

Sub Test()
    ' Set error handler
    On Error GoTo ErrorHandler

    Dim strElevation As String
    strElevation = InputBox("Enter elevation difference:", "Create Cross Lines", 0.5)

    If InStr(1, strElevation, ".") > 0 Then
        If Len(Mid(strElevation, InStr(1, strElevation, "."), Len(strElevation) - InStr(1, strElevation, "."))) > 2 Then
            MsgBox "cannot have more than 2 decimal places"
        End If
    End If

    Exit Sub

ErrorHandler:
    Call ReportError("Test")
End Subc

InputBox编辑控件的高级自定义

3 个答案: