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

Pre*_*cks 5 excel vba excel-vba

我认为这很简单,但事实证明这很困难.任何建议或想法都会被认可.

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

我可以只使用一个输入框,但是当输入密码时,任何其他人都可以看到密码.所以我想使用带有文本框的第二个表单并将其PasswordChar参数设置为*

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

if checkPassword("Please enter your password") = False then exit sub
Run Code Online (Sandbox Code Playgroud)

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

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

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

这是我调用表单的函数

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
Run Code Online (Sandbox Code Playgroud)

这是连接到表单OK按钮的子:

Private Sub passwordok_Click()

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

End Sub
Run Code Online (Sandbox Code Playgroud)

Sid*_*out 5

我可以只使用一个输入框,但是当输入密码时,任何其他人都可以看到密码.所以我想使用带有文本框的第二个表单并将其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
Run Code Online (Sandbox Code Playgroud)

在一个模块中

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
Run Code Online (Sandbox Code Playgroud)

快照

在此输入图像描述


Ale*_* K. 3

从对话框返回值是一项常见任务并且非常简单。

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

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
Run Code Online (Sandbox Code Playgroud)

用作

passworkOk = frmPassword.checkPassword("enter your blabla")
Run Code Online (Sandbox Code Playgroud)