VBA Cómo forzar a una función a regresar cuando se presiona un botón de formulario

Question

Pensé que esto sería simple, pero está resultando bastante difícil. Cualquier consejo o idea sería apreciado.

Tengo un formulario en Excel que dice que si se presiona un botón específico, necesito que el usuario ingrese una contraseña antes de que se ejecute el código para ese botón.

tan sólo pudiera utilizar una caja de texto, sino que permitirá a cualquier persona para ver la contraseña cuando se escribe. Así que quiero usar un segundo formulario con un cuadro de texto y establecer que es el parámetro PasswordChar a *

Aquí es el problema. Quiero usar un código como éste

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

checkPassword es una función que toma una cadena como parámetro. Esta función abre un formulario y coloca el mensaje en una etiqueta. El usuario debe ingresar la contraseña y hacer clic en Aceptar.

el sub btnOK_Click() debe comprobar que la contraseña es correcta y luego forzar la función que abrió el formulario para devolver True si la contraseña era correcta o False es la contraseña incorrecta.

No puedo encontrar la forma de forzar el regreso de la función. Intenté establecer una variable global en Verdadero o Falso cuando el usuario hace clic en Aceptar y luego descarga el formulario. Esto hace que la Función retorne, pero también restablece todas las variables globales establecidas por el formulario.

Aquí es mi función que llama a la forma

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 

Aquí está la sub relacionado con el botón formas OK:

Private Sub passwordok_Click() 

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

End Sub 

Answer 1

Volviendo un valor de un diálogo es una tarea común & muy simple de hacer.

El patrón más simple es colocar la función en el formulario de diálogo y hacer que esa función muestre su forma de host de forma modal.

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 

Utilizado como

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

Answer 2

tan sólo pudiera utilizar una caja de texto, pero eso permitirá que cualquier otra persona vea la contraseña cuando se ingresa. Por lo tanto, quiero usar un segundo formulario con un cuadro de texto y configurar su parámetro PasswordChar en *

Aquí es algo de mi base de datos.

RENUNCIA: Yo no escribo esto y no me acuerdo que escribió este

USO:

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 

en un módulo

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