我碰到这个了很多,我每次都使用相同的代码作为一种解决方法。我可以在网上找到的最早的参考文献是从ozgrid.com,其中提到Daniel Klann作为作者。
创建您的VBAProject一个新的模块,并放弃这一代码:
'////////////////////////////////////////////////////////////////////
'API functions to be used
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
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 SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32"() As Long
'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0
Private hHook As Long
Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim RetVal
Dim strClassName As String, lngBuffer As Long
If lngCode < HC_ACTION Then
NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
Exit Function
End If
strClassName = String$(256, " ")
lngBuffer = 255
If lngCode = HCBT_ACTIVATE Then 'A window has been activated
RetVal = GetClassName(wParam, strClassName, lngBuffer)
If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox
'This changes the edit control so that it display the password character *.
'You can change the Asc("*") as you please.
SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
End If
End If
'This line will ensure that any other hooks that may be in place are
'called correctly.
CallNextHookEx hHook, lngCode, wParam, lParam
End Function
Function InputBoxDK(Prompt, Title) As String
Dim lngModHwnd As Long, lngThreadID As Long
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
InputBoxDK = InputBox(Prompt, Title)
UnhookWindowsHookEx hHook
End Function
然后,而不是
Wachtwoord = InputBox("Geef het wachtwoord op")
用途:
Wachtwoord = InputBoxDK("Geef het wachtwoord op")
您可能需要保存并重启在创建新模块后创建excel。我通常将该模块命名为m_password
并将其导出为.bas文件,以便我可以重复使用它。它非常方便。
'InputBox'不支持密码字符。我会为此做一个简单的'UserForm' - 添加一个'TextBox'并将'PasswordChar'属性设置为'*'。 – Comintern
正如@comintern所说,'InputBox'不支持它。但是,创建并非不可能。看看这个http://www.ozgrid.com/forum/showthread.php?t=72794&p=374244#post374244它会得到你想要的,而不会创建一个'TextBox' – Niclas
@Niclas - 哇,设置一个键盘挂钩,以避免添加UserForm和10行代码?考虑到UserForm *已经有*键盘事件和一个'TextBox'已经内置了这个功能,这看起来有点过头了。这是否利用了我错过的'VBA.InputBox'的一些超棒的力量? – Comintern