Question

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

我设法为数据输入设置Userform，然后设置新的Userform以输入密码。

但是，我注意到如果密码用户表终止，则很容易绕过密码。

我试图让Userform_Terminate（）将用户带回到之前的Userform，但它只是创建了一个无限循环。

任何人都知道解决方法吗？

Private Sub UserForm_Terminate()

    Unload Me
    UserForm1.Show

End Sub

Answer 1

如果你需要的是禁止用户关闭UserForm，那么这是一个解决方案。

单击关闭按钮或Alt + F4禁用离开表单：

UserForm中的代码：

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

使表格上的关闭按钮不可点击并变灰：

UserForm中的代码：

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

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

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

用户表单输入密码

1 个答案: