如何扩展Excel VBA代码实现多供应商专属工作表密码验证？

需求背景 #

手头有一份给多家外部供应商用的预算工作簿，里面有1个内部主表（数据来自10+个独立项目表），要求每个供应商只能查看自己对应的项目表，完全碰不到其他项目表和主表。目前的思路是做一个默认打开的「home」工作表当入口，通过超链接跳转到受密码保护的项目表，每个供应商只知道自己对应表的密码。

现有单表实现代码 #

已经写了针对「Client 1」的工作簿级VBA代码，能实现点击对应工作表标签时弹出密码框，验证通过后才能查看，无需手动隐藏工作表：

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim xSheetName As String
    xSheetName = "Client 1"
    If Application.ActiveSheet.Name = xSheetName Then
        Application.EnableEvents = False
        Application.ActiveSheet.Visible = False
        xTitleId = "Please enter Client 1 Password"
        response = Application.InputBox("Password", xTitleId, "", Type:=2)
        If response = "1" Then
            Application.Sheets(xSheetName).Visible = True
            Application.Sheets(xSheetName).Select
        End If
    End If
    Application.Sheets(xSheetName).Visible = True
    Application.EnableEvents = True
End Sub

核心问题 #

怎么把这个单表的密码验证逻辑扩展到所有10+个项目工作表？

扩展实现方案 #

1. 建立密码映射表 #

先新增一个隐藏工作表，命名为PasswordMap，在这个表里做两列数据：

• A列：填写所有项目表的名称（比如「Client 1」「Client 2」…）
• B列：对应每个项目表的密码

做完后把这个表设为超级隐藏（右键工作表标签→隐藏，或者用VBA设置Sheets("PasswordMap").Visible = xlSheetVeryHidden），还要给工作表设置保护，防止被篡改。

2. 替换为通用VBA代码 #

把原来的单表代码删掉，换成下面的通用逻辑代码，不需要硬编码每个表名和密码：

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim ws As Worksheet
    Dim passwordMap As Worksheet
    Dim targetSheetName As String
    Dim correctPassword As String
    Dim userInput As String
    Dim foundRow As Range
    
    ' 排除不需要验证的工作表：home、主表、密码映射表
    If Sh.Name = "home" Or Sh.Name = "主表" Or Sh.Name = "PasswordMap" Then
        Exit Sub
    End If
    
    ' 锁定事件，防止循环触发
    Application.EnableEvents = False
    
    targetSheetName = Sh.Name
    Set passwordMap = ThisWorkbook.Sheets("PasswordMap")
    
    ' 从密码映射表查找对应表的密码
    Set foundRow = passwordMap.Range("A:A").Find(targetSheetName, LookIn:=xlValues, LookAt:=xlWhole)
    If foundRow Is Nothing Then
        ' 找不到对应表，切回home
        ThisWorkbook.Sheets("home").Select
        Application.EnableEvents = True
        Exit Sub
    End If
    correctPassword = foundRow.Offset(0, 1).Value
    
    ' 隐藏当前激活的表，弹出密码框
    Sh.Visible = False
    userInput = Application.InputBox("请输入" & targetSheetName & "的密码", "密码验证", "", Type:=2)
    
    ' 验证密码
    If userInput = correctPassword Then
        ' 验证通过，显示并选中该表
        Sh.Visible = True
        Sh.Select
    Else
        ' 验证失败，切回home
        ThisWorkbook.Sheets("home").Select
    End If
    
    ' 恢复事件
    Application.EnableEvents = True
End Sub

3. 配套设置 #

• 把「home」工作表设为默认打开的工作表：右键「home」标签→查看代码，在Workbook_Open事件里加一句ThisWorkbook.Sheets("home").Select
• 所有项目表、主表、PasswordMap表默认设为超级隐藏，只有验证通过后才会临时显示
• 给VBA工程设置密码保护：打开VBA编辑器→右键工程名→VBAProject属性→保护选项卡→勾选「锁定项目以查看」，设置密码，防止供应商查看或修改代码

内容的提问来源于stack exchange，提问作者SadFaceBadger