Fatal编程技术网
  • excel/
  • Excel 修复（强制）循环以保护/取消保护/隐藏/显示工作表

Excel 修复（强制）循环以保护/取消保护/隐藏/显示工作表

excel vba

Excel 修复（强制）循环以保护/取消保护/隐藏/显示工作表,excel,vba,Excel,Vba,在开始之前，我想感谢任何提供建议的人，因为这将是一篇很长的文章。我将在代码中包含所有细节，以便有人能帮助我注意到我遗漏了什么和/或做错了什么。我正在创建一个Excel工作簿，该工作簿将用于使用各种宏通过userforms注册销售和支出。为了保护文档并确定谁添加了什么，我设计了一个登录系统作为指南，但对我自己编写的代码进行了一些改进 这就是登录系统的工作原理。在名为Users的工作表上，我创建了两个表。第一个名为LoginRegistry（图中蓝色的一个），第二个名为Users（图中绿色的一个）

在开始之前，我想感谢任何提供建议的人，因为这将是一篇很长的文章。我将在代码中包含所有细节，以便有人能帮助我注意到我遗漏了什么和/或做错了什么。我正在创建一个Excel工作簿，该工作簿将用于使用各种宏通过
userforms
注册销售和支出。为了保护文档并确定谁添加了什么，我设计了一个登录系统作为指南，但对我自己编写的代码进行了一些改进

这就是登录系统的工作原理。在名为
Users
的
工作表上，我创建了两个表。第一个名为
LoginRegistry
（图中蓝色的一个），第二个名为
Users
（图中绿色的一个）。表
Users
中从
HOME
列到
Users
列的标题与工作簿上的工作表名称完全相同。它们的顺序也完全相同。当您双击该范围内的任何单元格时，它们会循环通过三个图标（仅使用相应的
Webdings
字体）。绿色图标使工作表可见并可编辑，蓝色图标使其可见但受保护，红色图标将其隐藏并保护（有点过分，但我喜欢这样做，以防存在任何漏洞）。
ALL
列一次更改所有权限。其代码如下所示：


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

  'Change icons when double clicking
  Set UserPermissions = Worksheets("Users").Range("Users[[ALL]:[USERS]]")
  UserPermissionsRange = UserPermissions.Address(0, 0)
  If Not Intersect(Target, Range(UserPermissionsRange)) Is Nothing Then
  
    'Change from empty to unlocked
    If Target.Value = Empty Then
      Target.Font.Color = RGB(0, 176, 80)
      Target.Value = "Ð"
      Cancel = True
    
    'Change from unlocked to read only
    ElseIf Target.Value = "Ð" Then
      Target.Font.Color = RGB(48, 84, 150)
      Target.Value = "N"
      Cancel = True
    
    'Change from read only to locked
    ElseIf Target.Value = "N" Then
      Target.Font.Color = RGB(255, 0, 0)
      Target.Value = "Ï"
      Cancel = True
    
    'Change from locked to unlocked
    ElseIf Target.Value = "Ï" Then
      Target.Font.Color = RGB(0, 176, 80)
      Target.Value = "Ð"
      Cancel = True
      
    End If
    
  Else
    Exit Sub
  
  End If
  
  'Modify all of the permissions at once
  If Target.Column = 10 Then
    AllWorksheetPermissions = "K" & Target.Row & ":" & "R" & Target.Row
    Range(AllWorksheetPermissions) = Target.Value
    Range(AllWorksheetPermissions).Font.Color = Target.Font.Color
    
  End If

End Sub


登录时捕获信息的
userform
名为
frmLoginForm
。每次打开工作簿时，都会执行以下代码：


Private Sub Workbook_Open()

  'Hide anything other than the form from the user
  Application.Visible = False
  'Show the worksheet that has all the information of the user permissions
  Sheets("Users").Visible = -1
  'Show login form to capture the user information
  frmLoginForm.Show

End Sub


这样，用户在进行身份验证之前无法执行任何操作。表单有两个文本框、两个按钮和三个标签。具体如下：


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

  'Change icons when double clicking
  Set UserPermissions = Worksheets("Users").Range("Users[[ALL]:[USERS]]")
  UserPermissionsRange = UserPermissions.Address(0, 0)
  If Not Intersect(Target, Range(UserPermissionsRange)) Is Nothing Then
  
    'Change from empty to unlocked
    If Target.Value = Empty Then
      Target.Font.Color = RGB(0, 176, 80)
      Target.Value = "Ð"
      Cancel = True
    
    'Change from unlocked to read only
    ElseIf Target.Value = "Ð" Then
      Target.Font.Color = RGB(48, 84, 150)
      Target.Value = "N"
      Cancel = True
    
    'Change from read only to locked
    ElseIf Target.Value = "N" Then
      Target.Font.Color = RGB(255, 0, 0)
      Target.Value = "Ï"
      Cancel = True
    
    'Change from locked to unlocked
    ElseIf Target.Value = "Ï" Then
      Target.Font.Color = RGB(0, 176, 80)
      Target.Value = "Ð"
      Cancel = True
      
    End If
    
  Else
    Exit Sub
  
  End If
  
  'Modify all of the permissions at once
  If Target.Column = 10 Then
    AllWorksheetPermissions = "K" & Target.Row & ":" & "R" & Target.Row
    Range(AllWorksheetPermissions) = Target.Value
    Range(AllWorksheetPermissions).Font.Color = Target.Font.Color
    
  End If

End Sub




表格后面的代码是：


Private Sub UserForm_Initialize()

  'Set custom colors to the form objects
  frmLoginForm.BackColor = RGB(240, 235, 215)
  cmdLogin.BackColor = RGB(201, 34, 23)
  cmdExit.BackColor = RGB(201, 34, 23)
  cmdLogin.ForeColor = vbWhite
  cmdExit.ForeColor = vbWhite

End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

  'Close the workbook whether the user closes the form with the "Exit button" or
  'clicking the "X" icon in the top right corner
  If CloseMode = vbFormControlMenu Then
    Cancel = True
    Unload frmLoginForm
    ThisWorkbook.Close

  End If

End Sub


Private Sub cmdLogin_Click()

  'Look for the valid user range
  Set UserRangeLookUp = Worksheets("Users").Range("Users[[USER]:[PASSWORD]]")
  
  On Error Resume Next
  'Find correct password
  CorrectPassword = Application.WorksheetFunction.VLookup(tbxUser.Value, UserRangeLookUp, 2, 0)
  
  If Err.Number = 1004 Then
  MsgBox "The user you entered does not exist."
  Err.Clear
  Else
  
    If StrComp(tbxPassword.Value, CorrectPassword, vbBinaryCompare) = 0 Then
      
      'Make worksheet visible
      Application.Visible = True
      
      'Only add a new row to the LoginRegistry table if it is empty
      If (Range("Users!B3").Value) = "" Then
      Else
        Worksheets("Users").ListObjects("LoginRegistry").ListRows.Add
      End If

      'Find the last row of the LoginRegistry (adding +2 to get the absolute reference)
      Set LoginRegistryRange = Worksheets("Users").Range("LoginRegistry")
      LoginRegistryLastRow = LoginRegistryRange.Rows.Count + 2
      
      'Last row of each column
      UserLastRow = "Users!" & "B" & LoginRegistryLastRow
      DateLastRow = "Users!" & "C" & LoginRegistryLastRow
      TimeLastRow = "Users!" & "D" & LoginRegistryLastRow
      
      'Save the information of the current login to the LoginRegistry 
      Range(UserLastRow).Value = tbxUser.Value
      Range(DateLastRow).Value = Format(Date, "dd/mm/yyyy")
      Range(TimeLastRow).Value = Format(Time, "hh:mm:ss")
      
      'Protect/unprotect/hide/show worksheets according to the user permissions
      Set UserListRangeLookup = Worksheets("Users").Range("Users[USER]")
      ActiveUserRow = Application.WorksheetFunction.Match(tbxUser.Value, UserListRangeLookup, 0) + 2
      
      'Loop through the columns `HOME` to `USERS` in the table `Users`. The headers containing
      'the worksheet names to reference are in the second row of this worksheet
      'Ð means unlocked and visible, N means locked and visible, Ï locked and not visible
      For i = 11 To 18
        If Cells(ActiveUserRow, i).Value = "Ð" Then
          Sheets(Cells(2, i).Value).Unprotect "123456"
          Sheets(Cells(2, i).Value).Visible = -1
        ElseIf Cells(ActiveUserRow, i).Value = "N" Then
          Sheets(Cells(2, i).Value).Protect Password:="123456"
          Sheets(Cells(2, i).Value).Visible = -1
        ElseIf Cells(ActiveUserRow, i).Value = "Ï" Then
          Sheets(Cells(2, i).Value).Protect Password:="123456"
          Sheets(Cells(2, i).Value).Visible = 2
        End If
      Next i
      
      'Show "HOME" worksheet first always
      Sheets("HOME").Activate
      
      'Close login form
      Unload frmLoginForm
    
    Else
      MsgBox "Incorrect password. Try again."
    
    End If
  
  End If


End Sub

Private Sub cmdExit_Click()

  'Code for the exit button on the form
  Unload frmLoginForm
  ThisWorkbook.Close

End Sub


所以，一旦我解释了所有这些，我就可以专注于我的问题了。问题是权限并不总是正确的。我无法找到代码被窃听时的确切情况，但有时当您登录时，会验证用户凭据，但工作簿上没有更新任何内容。例如，假设只查看少数工作表的用户，如果之前登录过，则仍然拥有管理员用户的所有权限。大多数情况下，一旦代码被破坏，它将无法再次工作，直到我更改表
Users
中已登录用户的一个权限。无论我尝试登录多少次，如果没有更改权限，它们将不会更改，并且工作表将保留最后一个可以正确登录的用户的权限

起初，我认为问题是因为具有权限的工作表被设置为“非常隐藏”，宏无法读取数据，但即使我将其放在末尾，并在每次打开工作簿时使其再次可见，问题仍在发生

现在，我相信这个循环是我的问题，但我就是找不到问题所在。循环如下（这正是我在前面的代码摘录中所展示的，我只是再次复制它，以便您可以关注代码的这一部分）：


如果您有任何建议，我将不胜感激。
潜在解决方案

只需浏览代码并查看突出显示的循环（在末尾），就会发现一个严重的问题（简单但严重）：您没有限定
单元格（）
引用。因此，它正在检查活动工作表的
单元格（ActiveUserRow，i）
的值，我假设它不是用户工作表，您刚刚在工作簿打开时使其可见。您不需要将此工作表设置为可见，当它是
xlSheetVeryHidden时，VBA访问它不会有任何问题

您应该做的第一件事是限定这些引用。如果这不起作用，请进行注释，以便我可以在您的代码中更深入地挖掘


      With ThisWorkbook.Sheets("USERS")
        For i = 11 To 18
          If .Cells(ActiveUserRow, i).Value = "Ð" Then
            Sheets(.Cells(2, i).Value).Unprotect "123456"
            Sheets(.Cells(2, i).Value).Visible = -1
          ElseIf .Cells(ActiveUserRow, i).Value = "N" Then
            Sheets(.Cells(2, i).Value).Protect Password:="123456"
            Sheets(.Cells(2, i).Value).Visible = -1
          ElseIf .Cells(ActiveUserRow, i).Value = "Ï" Then
            Sheets(.Cells(2, i).Value).Protect Password:="123456"
            Sheets(.Cells(2, i).Value).Visible = 2
          End If
        Next i
      End With


解决方案结束

更新（以下评论）：


    

  • 在访问
    xlSheetVeryHidden
    工作表（无论是VBA还是excel公式）中的单元格时，我从未遇到过任何问题。我得说我不知道。我测试了这个
    • 



    

  • 试着进入排位赛所有范围的习惯。事实上，如果前面没有
    ，您几乎不应该写入
    范围
    或
    单元格
    • 


你的代码结构清晰，逻辑清晰，做得很好。然而，请允许我指出一些改进的机会


    

  • 限定范围的常规方法是
    Sheets（“ShtName”）.range（“A1”）
    而不是
    range（“ShtName！A1”）
    。尽管这两种方法都有效，但前者使您的代码更具可读性，并且对于范围是否合格没有任何歧义。我有一种感觉，你的这种风格是你没有发现代码中的错误的原因。当我在你的代码中看到
    范围
    和
    单元格
    而没有
    时，我停止阅读其他内容，只是遵循这些范围的限定条件（或缺少）
    

    • 

  • 始终使用枚举而不是随机值。例如，您应该使用
    Sheet.Visible=xlSheetVisible
    而不是
    Sheet.Visible=-1
    

    • 

  • 我支持@TimWilliams在其评论中提出的观点。也可以使用
    转到ErrorHandler
    通知用户未找到名称，而不是
    继续下一步
    

    • 

  • 我会使用
    Match
    ranther而不是
    VLookup
    。这样你就不必按字母顺序排列你的桌子了
    

    • 

  • 组合框是用户名的更好选项，而不是文本框
    

    • 

  • 在
    cmdExit\u Click（）
    sub中，我还将关闭该工作

    Sub TestHiddenSheets()
    With Sheets("Sheet1")
        .Visible = xlSheetVeryHidden
        .Cells(1, 1) = 1
        .Protect
        Debug.Print .Cells(1, 1)
        .Visible = xlSheetVisible
    End With
    With Sheets("Sheet2")
        .Visible = xlSheetHidden
        .Cells(1, 1) = 2
        .Protect
        Debug.Print .Cells(1, 1)
        .Visible = xlSheetVisible
    End With
End Sub