高度なカスタマイズが

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()を実行すると、ユーザーフォーム上に示されたカップルの異なるアプローチが表示されます。 最初のテキストボックス自動的ラウンド入力、2番目のテキストボックスは彼らは小数点以下以下を使用するための入力を修正しない限り、ユーザーはを継続することはできませんが。もちろん

あなたには、いくつかのエラー処理を追加して、フォームが素敵に見えるようにしたいでしょうが、これはあなたのユーザー入力を取得するために、VBAのフォームを使用する方法の簡単な例を示します。これらのコードにはもう少しコードが含まれていますが、単純なInputBox()機能に比べるとかなりのレベルの柔軟性が備わっていることは明らかです。

3. WindowsのAPIは、実際には入力ボックス上のコントロールに影響を与えるために、WindowsのAPIをコールを使用する方法がありますが、ただ、完全性について

を呼び出しますが、これは最初の2よりもはるかに複雑になってしまうでしょう私はこのようなことをお勧めしません。

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 

は、自分の状況に適用しますが、これは難易度のために...あなたは基本的にここに3つのオプションがありますが

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