Inputbox mit vorgegebenen Eingabezeichen und begrenzter Eingabelänge

[volti]

Hallo liebe Leserin, lieber Leser,

manchmal wünscht man sich, dass die Inputbox, die ja gerne zur Eingabe von Texten genommen wird, auch bezüglich der einzugebenden Zeichen und/oder auf eine bestimmte Länge beschränkt wird.

Natürlich kann man nach Klicken des OK-Buttons das Ergebnis entsprechend behandeln oder zur Korrektureingabe neu starten.
Schöner ist jedoch, gleich bei der Eingabe eines nicht gewünschten Zeichens, dieses erst gar nicht anzunehmen.

Und dass das durchaus möglich ist, möchte ich hier mal an einem Beispiel aufzeigen.

Mit ein paar API-Befehlen beschaffen wir uns das Handle der Inputbox und dann das Handle der darin enthaltenen Editbox.
Anschließend leiten wir die von Windows an die Editbox gesendeten Messages in eine eigene Sub um.

Dort können wir nun schalten und walten, wie es für unser Ziel erforderlich ist.

In unserem Fall prüfen wir zunächst das gerade eingegebene Zeichen auf Gültigkeit und verhindern die Weiterleitung dieses Zeichens an die Editbox, wenn es nicht gewünscht ist.
Dann ermitteln wir die aktuelle Textlänge in der Editbox und prüfen auch diese.

PS: Mit der Inputbox kann auch leicht ein Fortschrittsbalken oder auch eine begrenzte Eingabezeit realisiert werden.

Und nun viel Spaß beim Ausprobieren...

Code:

Option Explicit

Private Declare PtrSafe Function SetTimer Lib "user32" ( _
        ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
        ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" ( _
        ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Private Declare PtrSafe Function FindWindowA Lib "user32" ( _
        ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function CallWindowProcA Lib "user32" ( _
        ByVal lpPrevWndFunc As LongPtr, _
        ByVal hwnd As LongPtr, ByVal Msg As Long, _
        ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
#If Win64 Then
 Private Declare PtrSafe Function SetWindowLongA Lib "user32" _
         Alias "SetWindowLongPtrA" ( _
         ByVal hwnd As LongPtr, ByVal nIndex As Long, _
         ByVal dwNewLong As LongPtr) As LongPtr
#Else
 Private Declare PtrSafe Function SetWindowLongA Lib "user32" ( _
         ByVal hwnd As LongPtr, ByVal nIndex As Long, _
         ByVal dwNewLong As LongPtr) As LongPtr
#End If
Private Declare PtrSafe Function GetDlgItem Lib "user32" ( _
        ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As LongPtr
Private Declare PtrSafe Function GetWindowTextLengthA Lib "user32" ( _
        ByVal hwnd As LongPtr) As Long

Private Const GWL_WNDPROC = -4

Dim hTimer    As LongPtr, glpOldProc As LongPtr
Dim gsCaption As String, gsPruef     As String
Dim giMax As Integer

Function InputBoxEx(sMsgTxt As String, sCaption As String, _
                    Optional sDefault As String, _
                    Optional sPruef As String, _
                    Optional iMax As Integer) As Variant
' Anzeigen einer Inputbox mit Eingabeprüfung
  gsCaption = sCaption: gsPruef = sPruef: giMax = iMax                  ' Parameter global übernehmen
  hTimer = SetTimer(0&, 0&, 25, AddressOf InputBoxHookProc)             ' Timer setzen
  InputBoxEx = InputBox(sMsgTxt, gsCaption, sDefault)                   ' (Excel)-Inputbox starten
End Function

Private Sub InputBoxHookProc()
' Setzt die Hooking-Prozedur für das InputBox-Texteingabefeld
  Dim hwnd As LongPtr
  
  KillTimer 0&, hTimer:       hTimer = 0                                ' Timer löschen
  hwnd = FindWindowA("#32770", gsCaption)                               ' Handle der Inputbox suchen
  If hwnd <> 0 Then
     hwnd = GetDlgItem(hwnd, 4900) ' Edit_ID                            ' Handle der Editbox
     glpOldProc = SetWindowLongA(hwnd, GWL_WNDPROC, AddressOf WindowProc) ' (Excel)-Inputbox hooken
  End If
End Sub

Private Function WindowProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, _
        ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
' Verarbeitet die Messages für dieses Fenster
  If uMsg = &H102 And wParam > 31 Then ' &H102 = WM_CHAR
' Hier kannst Du Deine Prüfungen durchführen
     If InStr(gsPruef, Chr$(CByte(wParam))) = 0 Then Exit Function      ' Zeichen checken
     If GetWindowTextLengthA(hwnd) >= giMax And giMax > 0 Then Exit Function ' Textlänge checken
  End If
  WindowProc = CallWindowProcA(glpOldProc, hwnd, uMsg, wParam, lParam)  ' Andere Messages weiterleiten
End Function

' #####################################################################
Sub AufruftestPruef()
  MsgBox (InputBoxEx("Bitte gib nur Zahlen ein!" & vbLf _
      & "Es sind nur 5 Zeichen erlaubt!", "Meine Dateneingabe", "", "0123456789,", 5))
End Sub

_________
viele Grüße
Karl-Heinz

---

Hallo zusammen,

zum Thema hier noch eine ergänzende Datei zum Spielen und Anschauen.
Enthalten sind die vorgenannte Inputbox-Version mit der Zeichenbegrenzung und Beispiele zur automatischen Eingabevervollständigung, Inputbox mit begrenzter Eingabezeit mit TimeOut und Beispiele zur Postleitzahl- und Ortssuche.

Viele Grüße
Karl-Heinz