隐藏macros中的字符以进行密码控制

我创build了一个插入图片的macros，当一个人按下电子表格上的一个button时，下面的macros将会运行，并且一个消息框将出现，供个人input密码，如果图片插入正确的话。 这工作正常，但我想消息框来隐藏星星密码，例如********

这是目前的macros：

Sub M_Reeve() 'Create the password message box Dim Answer As String Answer = InputBox("Input Operator Stamp Password", "Password") If Answer = "Martin" Then 'Run the copy and paste "Stamp1" macro from module 2 Stamp1 'return an error if wrong password Else: MsgBox "Wrong password", vbCritical + vbOKCancel, "Incorrect Password" End If End Sub 

提前致谢

Answer 1

这个工作在Excel 2010 32位的我。

创build新模块并粘贴以下代码：

 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 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 

然后在你的代码中用InputBoxDKreplaceInputBoxDK

我发现这个代码在networking中的其他网站，我记得它是由@Siddharth路特。