ich möchte bei einer Inputbox die Eingabe gern wie ein Kennwortfeld behandeln.
Wie kann ich dies machen? Ich möchte nicht extra eine Userform verwenden.
Danke Euch
VG
Steffen Schmerler
Option Explicit
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadID As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" ( _
ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
ByVal lParam As Any) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
ByVal hWnd As Long, _
ByRef lpdwProcessId As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Const WH_KEYBOARD = 2
Private Const HC_ACTION = 0
Private Const EM_SETPASSWORDCHAR = &HCC
Dim hHook As Long
Dim hThread As Long
Dim hWnd As Long
Dim IsHooked As Boolean
Sub test_inputboxhook()
' Ein String der Passwort übernimmt.
Dim strPwd As String
' Den Hook setzen.
SetKeyboardHook
' Aufruf einer InputBox und einlesen des Passwortes.
strPwd = InputBox("Bitte geben Sie den Code ein:")
' Den Hook entfernen.
RemoveKeyboardHook
' Ausgabe/Weiterverarbeitung des Passwortes.
MsgBox strPwd
End Sub
Public Sub SetKeyboardHook()
If Not IsHooked Then
hWnd = GetForegroundWindow
hThread = GetWindowThreadProcessId(hWnd, 0)
If hThread Then _
hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf WndKeyBoardProc, 0, hThread)
If hHook Then _
IsHooked = True
End If
End Sub
Public Sub RemoveKeyboardHook()
Dim RetVal As Long
RetVal = UnhookWindowsHookEx(hHook)
IsHooked = False
End Sub
Public Function WndKeyBoardProc(ByVal uCode As Long, ByVal wParam As Long, ByVal lParam As Long) _
As Long
If uCode >= 0 Then
Select Case uCode
Case HC_ACTION
Call SendMessage(FindWindowEx(GetForegroundWindow, 0, "Edit", ""), _
EM_SETPASSWORDCHAR, 42, lParam)
Case Else
' Tue nichts ...
End Select
End If
WndKeyBoardProc = CallNextHookEx(hHook, uCode, wParam, lParam)
End Function