vba VBA如何在按下表单按钮时强制函数返回

VBA How to force a function to Return when a Form Button is pressed

提问by PrestonDocks

I thought this would be simple, but it is proving quite difficult. Any advice or ideas would be appretiated.

我以为这很简单，但事实证明这很困难。任何建议或想法将被appretiated。

I have a form in Excel that if a certain button is pressed I need the user to enter a password before the code for that button is run.

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

I could just use a inputbox, but that will allow anyone else to see the password when it is typed in. So I want to use a second form with a textbox and set it's PasswordChar parameter to *

我可以只使用输入框，但这将允许其他人在输入密码时看到密码。所以我想使用带有文本框的第二个表单并将其 PasswordChar 参数设置为 *

Here is the problem. I want to use code like this

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

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

checkPasswordis a function that takes a string as a parameter. This function opens a form and puts the message in to a lable. The user should enter the password and click OK.

checkPassword是一个将字符串作为参数的函数。此函数打开一个表单并将消息放入标签中。用户应输入密码并单击确定。

the sub btnOK_Click()should check the password is correct and then force the function that opened the form to return True if the password was OK or False is the password was incorrect.

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

I just cant work out how to force the function to return. I have tried setting a global variable to either True or False when the user click OK and then unloading the form. This makes the Function return, but it also resets all the global variables set by the form.

我只是不知道如何强制函数返回。当用户单击“确定”然后卸载表单时，我尝试将全局变量设置为 True 或 False。这使得函数返回，但它也重置了表单设置的所有全局变量。

Here is my function that calls the form

这是我调用表单的函数

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

Here is the sub linked to the forms OK button:

这是链接到表单 OK 按钮的子链接：

Private Sub passwordok_Click()

  If Me.passwordtext.Text = "password" Then
      passwordStatus = True
  Else
      passwordStatus = False
  End If
  Unload Me

End Sub

采纳答案by Alex K.

Returning a value from a dialog is a common task & pretty simple to do.

从对话框返回一个值是一项常见的任务，而且非常简单。

The simplest pattern is to put the function in the dialog form itself and have that function show its host form modally.

最简单的模式是将函数放在对话窗体本身中，并让该函数以模态方式显示其宿主窗体。

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 
  '//i.e. 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

Used as

用作

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

回答by Siddharth Rout

I could just use a inputbox, but that will allow anyone else to see the password when it is typed in. So I want to use a second form with a textbox and set it's PasswordChar parameter to *

我可以只使用输入框，但这将允许其他人在输入密码时看到密码。所以我想使用带有文本框的第二个表单并将其 PasswordChar 参数设置为 *

Here is something from my database.

这是我的数据库中的一些内容。

DISCLAIMER: I DIDN'T WRITE THIS AND I DON'T REMEMBER WHO WROTE THIS

免责声明：这不是我写的，我不记得是谁写的

USAGE:

用法：

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

IN A MODULE

在一个模块中

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

SNAPSHOT

快照