VBA Cách buộc một chức năng trở lại khi một Nút Biểu mẫu được nhấn

Question

Tôi nghĩ điều này sẽ đơn giản, nhưng điều đó chứng tỏ khá khó khăn. Bất kỳ lời khuyên hay ý tưởng nào sẽ được ứng dụng.

Tôi có một biểu mẫu trong Excel rằng nếu một nút nhất định được nhấn, tôi cần người dùng nhập mật khẩu trước khi mã cho nút đó được chạy.

Tôi chỉ có thể sử dụng một inputbox, nhưng điều đó sẽ cho phép bất cứ ai khác để xem mật khẩu khi nó được gõ vào. Vì vậy, tôi muốn sử dụng một hình thức thứ hai với một textbox và đặt nó là tham số PasswordChar để *

đây là vấn đề. Tôi muốn sử dụng mã như thế này

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

checkPassword là hàm lấy chuỗi làm tham số. Hàm này mở một biểu mẫu và đặt thông báo vào một lable. Người dùng nên nhập mật khẩu và nhấn OK.

phụ btnOK_Click() nên kiểm tra mật khẩu chính xác và sau đó buộc chức năng mở biểu mẫu trả về True nếu mật khẩu OK hoặc Sai là mật khẩu không chính xác.

Tôi không thể biết cách ép buộc hàm trả về. Tôi đã thử đặt một biến toàn cục thành True hoặc False khi người dùng bấm OK và sau đó dỡ bỏ biểu mẫu. Điều này làm cho hàm trả về, nhưng nó cũng đặt lại tất cả các biến toàn cầu được thiết lập bởi biểu mẫu.

Đây là chức năng của tôi mà các cuộc gọi dưới dạng

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 

Đây là phụ liên kết với nút hình thức OK:

Private Sub passwordok_Click() 

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

End Sub 

Answer 1

Trả về một giá trị từ một hộp thoại là một nhiệm vụ chung & khá đơn giản để làm.

Mẫu đơn giản nhất là đặt hàm trong chính biểu mẫu hộp thoại và có chức năng đó hiển thị biểu mẫu máy chủ của nó một cách bình thường.

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 

Được sử dụng như

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

Answer 2

Tôi chỉ có thể sử dụng một inputbox, nhưng điều đó sẽ cho phép bất kỳ ai khác xem mật khẩu khi nó được nhập. Vì vậy, tôi muốn sử dụng biểu mẫu thứ hai với một hộp văn bản và đặt tham số PasswordChar thành *

Dưới đây là một cái gì đó từ cơ sở dữ liệu của tôi.

SỰ TỪ BỎ: Tôi đã không viết NÀY VÀ TÔI KHÔNG NHỚ người đã viết

SỬ DỤNG NÀY:

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 

TRONG MỘT PHẦN

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