VBA如何强制一个函数返回时按下表单button

我认为这很简单,但是certificate相当困难。 任何build议或想法都将是令人满意的。

我在Excel中有一个表单,如果按下某个button,我需要用户在运行该button的代码之前input密码。

我可以只使用一个input框,但是这将允许其他人看到input密码。所以我想用一个文本框的第二个表单,并将其PasswordChar参数设置为*

这是问题。 我想使用这样的代码

if checkPassword("Please enter your password") = False then exit sub 

checkPassword是一个将string作为参数的函数。 这个函数打开一个表单并把消息放入标签中。 用户应input密码并单击确定。

btnOK_Click()应检查密码是否正确,然后强制打开表单的函数返回True,如果密码是OK或False是密码不正确。

我只是不能解决如何强制函数返回。 我试图设置一个全局variables为True或False当用户单击确定,然后卸载窗体。 这使得函数返回,但它也重置由表单设置的所有全局variables。

这是我的函数调用窗体

 Function checkPassword(message As String) As Boolean frmPassword.Show frmPassword.passwordMsg.Caption = message 'passwordStatus is a global variable If passwordStatus = True Then checkPassword = True Else checkPassword = False End Function 

这里是链接到表单确定button的子:

 Private Sub passwordok_Click() If Me.passwordtext.Text = "password" Then passwordStatus = True Else passwordStatus = False End If Unload Me End Sub 

从对话框中返回一个值是一个常见的任务,很简单。

最简单的模式是将函数放在对话框的forms本身,并有该function模态地显示其主机forms。

 Private passwordStatus As Boolean Function checkPassword(message As String) As Boolean '//setup the form Me.passwordMsg.Caption = message '//show the form modally, this will not return until the form is unloaded '//ie when the button is clicked; so values in private variable are still valid Me.Show vbModal '//form is unloaded (via unload me or a close) return the value; checkPassword = passwordStatus End Function Private Sub passwordok_Click() passwordStatus = Me.passwordtext.Text = "password" Unload Me End Sub 

用作

 passworkOk = frmPassword.checkPassword("enter your blabla") 

我可以只使用一个input框,但是这将允许其他人看到input密码。所以我想用一个文本框的第二个表单,并将其PasswordChar参数设置为*

这是从我的数据库中的东西。

免责声明 :我不写这个,我不记得写这个

用法

 Private Sub passwordok_Click() Dim Prompt, password As String Prompt = "Please enter your password." password = InputBoxDK(Prompt) MsgBox password '<~~ Do whatever you want to do with this End Sub 

在模块中

 Option Explicit 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 'A window has been activated 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 

快照

在这里输入图像描述