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

时间:2012-04-26 08:52:57

标签: excel vba excel-vba

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

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

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

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

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

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

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

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

Private Sub passwordok_Click()

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

End Sub

2 个答案:

答案 0 :(得分:5)

  
    
      

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

    
  

以下是我的数据库中的内容。

免责声明:我没有写过这篇文章而且我没有记得世界卫生组织错过了这个

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

在模块中

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

<强>快照

enter image description here

答案 1 :(得分: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

用作

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