excel - 更新到 VBA7 导致用户名和密码提示错误
问题描述
我有以下在 Excel 2010 中工作的代码(提示用户在打开工作簿时输入用户名和密码以及用“*”屏蔽密码)。我的 Excel 已更新到 Excel 2013,现在代码不起作用。在提示我输入用户名后,它会出现“类型不匹配”的错误,当我在 VBA 编辑器中查看时,会突出显示以下内容
Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
Optional YPos, Optional HelpFile, Optional Context) As String
随着AddressOf NewProc
下面的代码是打开工作簿时获取用户名和密码的整个序列。
#If VBA7 Then
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
#Else
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias _
"GetModuleHandleA" (ByVal lpModuleName As String) As Long
#Else
Private Declare Function GetModuleHandle Lib "kernel32" Alias _
"GetModuleHandleA" (ByVal lpModuleName As String) As Long
#End If
#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
#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
#End If
#If VBA7 Then
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
#Else
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe 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
#Else
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
#End If
#If VBA7 Then
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
#Else
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
#Else
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
#End If
'~~> 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
RetVal = GetClassName(wParam, strClassName, lngBuffer)
'~~> Class name of the Inputbox
If Left$(strClassName, RetVal) = "#32770" Then
'~~> 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
Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
Optional YPos, Optional HelpFile, Optional Context) 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, Default, XPos, YPos, HelpFile, Context)
UnhookWindowsHookEx hHook
End Function
Sub auto_open()
strUser = InputBox("Please Enter Your User ID.")
strPwd = InputBoxDK("Please Enter Your Password.")
End Sub
解决方案
推荐阅读
- regex - sed 替换负数
- apache-spark - Spark java.lang.NoSuchMethodError 使用地图
- javascript - React:从 datalist 选项 onchange 获取数据属性
- c++ - 由于制表顺序,鼠标光标总是得到错误的 hwnd - MFC 应用程序
- css - 为不同的断点设置元素的大小
- realm - kerberos 配置具有多个域的单个 kdc
- python - 应用“setattr”后如何捕获原始函数的参数?
- html - 对 css 和 html 没有响应
- c# - 有没有一种方法可以多次运行一个方法,每次运行前增加时间?
- django - 我可以将 UserCreationFrom() html 的语言更改为西班牙语吗?