多人协作场景下VBA自动工作表保护密码丢失问题求助

我完全明白你碰到的这个棘手问题了——你用VBA实现了工作簿打开时自动解锁工作表，再用UserInterfaceOnly:=True模式重新保护，这样既能让用户在保护状态下用分组、筛选功能，又能让宏正常写入数据，全程用全局变量存固定密码。但糟心的是，当其他用户在文件被占用时打开它，会出现找不到当前保护密码的情况，只能靠ZIP破解才能解锁，这确实太影响使用了。

问题根源 #

核心原因在于UserInterfaceOnly这个保护模式的特性：它是仅在当前Excel会话中生效的临时保护，并不会被保存到工作簿文件里。当其他用户以只读模式打开被占用的文件时，工作簿里并没有存储有效的保护密码（你用的是临时UI-only保护，且全局变量的密码不会被写入文件），所以他们看到的是“被锁定但无密码可输入”的异常状态，自然无法正常解锁。

解决方案：调整保护逻辑，适配多用户场景 #

我们可以通过修改代码，在工作簿保存前切换回常规密码保护，打开时再重新启用UI-only模式，同时优化密码的存储方式，避免会话依赖问题。

1. 优化工作簿打开事件（Workbook_Open） #

把密码定义为模块级变量（避免全局变量的潜在问题），确保打开时统一处理所有工作表的保护切换：

Private Sub Workbook_Open()
    Dim Passwort As String
    Passwort = "123"
    
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        ' 处理可能未被保护的工作表，避免报错
        On Error Resume Next
        ws.Unprotect Password:=Passwort
        On Error GoTo 0
        
        ' 重新启用UI-only保护，保留所需权限
        ws.Protect _
            UserInterfaceOnly:=True, _
            Password:=Passwort, _
            AllowFormattingCells:=True, _
            EnableAutoFilter:=True, _
            EnableOutlining:=True
    Next ws
End Sub

2. 添加工作簿保存前事件（Workbook_BeforeSave） #

保存前切换回常规密码保护，确保文件存储的是正常的带密码保护状态，其他用户打开时能读取到正确的密码：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Passwort As String
    Passwort = "123"
    
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        On Error Resume Next
        ws.Unprotect Password:=Passwort
        On Error GoTo 0
        
        ' 应用常规密码保护，保留必要操作权限
        ws.Protect _
            Password:=Passwort, _
            AllowFormattingCells:=True, _
            AllowFiltering:=True, _
            AllowOutlining:=True
    Next ws
End Sub

3. 调整数据加载宏的保护逻辑 #

在宏执行前后统一处理保护状态，确保宏运行时工作表处于解锁状态，执行完成后恢复UI-only保护：

Sub 加载外部数据()
    Dim Passwort As String
    Passwort = "123"
    Dim ws As Worksheet
    
    ' 执行前解锁所有工作表
    For Each ws In ThisWorkbook.Worksheets
        On Error Resume Next
        ws.Unprotect Password:=Passwort
        On Error GoTo 0
    Next ws
    
    ' 你的原有数据加载逻辑
    LadenAusExternerDatei (Datum)
    nachsteMaschine = 2
nextloop:
    Err.Clear
    aktuelleMaschine = Tabelle7.Range(Cells(nachsteMaschine - 1, 1), Cells(1500, 1)).End(xlDown).Row
    nachsteMaschine = Tabelle7.Cells(aktuelleMaschine, 1).End(xlDown).Row
    
    If aktuelleMaschine = Tabelle7.Cells(1048576, 1).End(xlUp).Row + zaehler Then
        ' 执行完成后恢复UI-only保护
        For Each ws In ThisWorkbook.Worksheets
            ws.Protect _
                UserInterfaceOnly:=True, _
                Password:=Passwort, _
                AllowFormattingCells:=True, _
                EnableAutoFilter:=True, _
                EnableOutlining:=True
        Next ws
        Exit Sub
    End If
    
    If nachsteMaschine >= aktuellMaschine + 1000 Then
        ' 执行完成后恢复UI-only保护
        For Each ws In ThisWorkbook.Worksheets
            ws.Protect _
                UserInterfaceOnly:=True, _
                Password:=Passwort, _
                AllowFormattingCells:=True, _
                EnableAutoFilter:=True, _
                EnableOutlining:=True
        Next ws
        Exit Sub
    End If
End Sub

额外优化建议 #

• 把密码定义为模块级常量：在标准模块中添加Const PASSWORT As String = "123"，这样所有宏都能访问，且不会因为会话重启或多用户打开而丢失
• 更高安全性方案：如果担心明文密码的风险，可以把密码存储在隐藏的加密工作表中，宏运行时再读取，避免代码中直接暴露密码

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