文字入力の制限をするには？ (ID:108603)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

なるほど、確かにKeyPressで処理しても良いですね。
入力に関してのみ、色々なことを考えてみたんですがこんなのどうでしょう？
貼り付け禁止、マイナス符号は頭に一つのみ、小数点以下は２桁までしか入力できません。
桁数は最大10桁まで。

Option Explicit

'SendMessage
Private Declare Function SendMessage _
    Lib "user32.dll" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Any) _
        As Long

'アンドゥ
Private Const WM_UNDO As Long = &H304&

Private bNotChange As Boolean

Private Sub Form_Load()
    
    With Text1
        .IMEMode = 3
        .MaxLength = 10
    End With
End Sub

Private Sub Text1_Change()
    Static bUndo As Boolean
    
    If bUndo Or bNotChange Then
        bNotChange = False
        Exit Sub
    End If
    
    bUndo = True
    
    '貼り付け禁止（アンドゥ）
    Call SendMessage(Text1.hWnd, WM_UNDO, 0, 0)
    
    bUndo = False
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    
    'デリートも許可
    If KeyCode = vbKeyDelete Then
        bNotChange = True
    End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    Dim sText$, sBuff As String
    Dim lPos As Long
    Const sFilter As String = "-.0123456789"
    
    sBuff = Chr$(KeyAscii)
    
    bNotChange = True
    
    If InStr(sFilter, sBuff) > 0 Then
        With Text1
            sText = .Text
            
            If sBuff = "-" Then
                'マイナス符号
                
                If Not (.SelStart = 0 And Left$(sText, 1) <> sBuff) Then
                    '頭に一つのみ許可
                    KeyAscii = 0
                End If
                
            ElseIf sBuff = "." Then
                '小数点
                
                lPos = .SelStart
                If lPos > 0 Then
                    '小数点以下は２桁まで
                    If lPos < Len(sText) - 2 Then
                        KeyAscii = 0
                    ElseIf Len(sText) - Len(Replace$(sText, sBuff, vbNullString)) > 0 Then
                        KeyAscii = 0
                    End If
                Else
                    '頭には小数点は付けない
                    KeyAscii = 0
                End If
                
            Else
                '数字
                
                sBuff = Replace$(sText, "-", vbNullString)
                sBuff = Replace$(sText, ".", vbNullString)
                
                If Len(sBuff) >= 8 Then
                    '数字は８桁まで（マイナス符号と小数点を含めると最大10桁）
                    KeyAscii = 0
                Else
                    lPos = InStr(sText, ".")
                    If lPos > 0 Then
                        '小数点がある場合
                        If .SelStart >= lPos And Len(sText) > lPos + 1 Then
                            '小数点以下は２桁まで
                            KeyAscii = 0
                        End If
                    End If
                End If
            End If
        End With
        
    ElseIf KeyAscii = vbKeyBack Then
        'バックスペースは許可
        
    Else
        '他のものは不許可
        bNotChange = False
        KeyAscii = 0
        
    End If
End Sub

←解決時は質問者本人がここをチェックしてください。

戻る