CODEWITHSUNDEEP
vbaexcelexcel-2010
Barbaaz
Barbaaz

Reputation: 105

Userform for password input

I'm working on an Excel Workbook that uses VBA for data input, since I don't want the application itself to be available to the user if the user does not know the password.

I managed to set up the Userform for data input and then a new Userform for the password input.

However, I noticed that the password is easily bypassed if the Password Userform is terminated.

I tried to make the Userform_Terminate() take the user back to the previous Userform, but it just creates an endless loop.

Anyone know a workaround for this?

Private Sub UserForm_Terminate()

    Unload Me
    UserForm1.Show

End Sub

Upvotes: 0

Views: 231

Answers (1)

Ryszard Jędraszyk
Ryszard Jędraszyk

Reputation: 2412

If what you need is disallowing user closing UserForm, then here is a solution.

Disable leaving form with either close button click or Alt+F4:

Code within UserForm:

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then Cancel = True
End Sub

Make close button on form unclickable and grayed out:

Code within UserForm:

Private Sub UserForm_Initialize()
    DisableCloseButton (Me.Caption) 'disable close button (X)
End Sub

Code within a module, works for 32 and 64 bit:

Option Explicit

Private Const MF_BYPOSITION = &H400
Private Const MF_REMOVE = &H1000

#If VBA7 Then '64 bit
    Private Declare PtrSafe Function DrawMenuBar Lib "User32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetMenuItemCount Lib "User32" (ByVal hMenu As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetSystemMenu Lib "User32" (ByVal hwnd As LongPtr, ByVal bRevert As LongPtr) As LongPtr
    Private Declare PtrSafe Function RemoveMenu Lib "User32" (ByVal hMenu As LongPtr, ByVal nPosition As LongPtr, ByVal wFlags As LongPtr) As LongPtr
    Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private hwnd As LongPtr
#Else '32 bit
    Private Declare Function DrawMenuBar Lib "User32" (ByVal hwnd As Long) As Long
    Private Declare Function GetMenuItemCount Lib "User32" (ByVal hMenu As Long) As Long
    Private Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
    Private Declare Function RemoveMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
    Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private hwnd As Long
#End If

Public Sub DisableCloseButton(ByVal formCaption As String) 'deactivates the upper right "x" in the user form

    #If VBA7 Then '64 bit
        Dim hMenu As LongPtr, menuItemCount As LongPtr
    #Else '32 bit
        Dim hMenu As Long, menuItemCount As Long
    #End If

    hwnd = FindWindow(vbNullString, formCaption) 'Obtain the window handle to the userform
    hMenu = GetSystemMenu(hwnd, 0) 'Obtain the handle to the form's system menu

    'Clear list box
    If hMenu Then

        menuItemCount = GetMenuItemCount(hMenu) 'Obtain the number of items in the menu

        'Remove the system menu Close menu item. The menu item is 0-based, so the last item on the menu is menuItemCount - 1
        Call RemoveMenu(hMenu, menuItemCount - 1, MF_REMOVE Or MF_BYPOSITION)
        Call RemoveMenu(hMenu, menuItemCount - 2, MF_REMOVE Or MF_BYPOSITION) 'Remove the system menu separator line
        Call DrawMenuBar(hwnd) 'Force a redraw of the menu. This refreshes the titlebar, dimming the X

    End If

End Sub

Upvotes: 1

Related Questions