InputBox mit Sternchen in Excel2013 64bit-Version
09.10.2014 05:07:36
Kasimir
Ich habe da ein Problem. Ich habe hier im Forum vor gewisser Zeit ein Makro gefunden, das mi die Eingabe in einer InputBox als Sternchen darstellt. Nun möchte ich diesen Code in Excel 2013 64bit verwenden. Mir wurde beim 1. Starten ein Fenster eingeblendet, aus dem hervor ging, dass die Declare-Anweisung um ein PtrSafe-Atribut erweitert werden muss. Das habe ich nun getan und es werden beim Starten keine Fehler mehr angezeigt. Nachfolgend mal mein jetziger Code:
Option Explicit
#If VBA7 Then
Private Declare PtrSafe 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 PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As Long) As Long
Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
ByVal lParam As Any) As Long
Private Declare PtrSafe 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 PtrSafe Function GetForegroundWindow Lib "user32" () As Long
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" ( _
ByVal hWnd As Long, _
ByRef lpdwProcessId As Long) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
#Else
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
#End If
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
Wenn ich nun aber das Makro zum Aufruf der InputBox aufrufe erhalte ich die Fehlermeldung Fehler beim Kompilieren: Typen unverträglich und es wird mir im Makro SetKeyboardHook() in der Zeile
hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf WndKeyBoardProc, 0, hThread)
der Text
AddressOf WndKeyBoardProc
blau markiert. Ich weiß jetzt ehrlich gesagt nicht, was daran falsch ist, da der Code ja in anderen Excelversionen funktioniert. Kennt von Euch vielleicht jemand das Problem oder hatte dies ebenfalls schon mal und kann mir sagen, was da schief läuft? Wäre super.
Jedenfalls schon mal besten Dank für die Unterstützung,
Kasimir