密码输入用户表格 [英] Userform for password input

问题描述

我正在研究使用VBA进行数据输入的Excel工作簿，因为如果用户不知道密码，我不希望应用程序本身对用户可用.

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.

我试图使Userform_Terminate()将用户带回以前的Userform，但这只会造成一个无限循环.

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

有人知道解决方法吗?

Private Sub UserForm_Terminate()

    Unload Me
    UserForm1.Show

End Sub

推荐答案

如果您需要禁止用户关闭UserForm，那么这里是一个解决方案.

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

通过单击关闭按钮或Alt + F4来禁用离开表单:

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

UserForm中的代码:

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:

UserForm中的代码:

Code within UserForm:

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

模块内的代码，适用于32位和64位:

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

这篇关于密码输入用户表格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！