VBA如何创建应用级事件处理器 附代码失效问题排查

你的代码不生效是几个错误叠在一起导致的：

• 代码放错了模块：你把带WithEvents的应用对象声明、Workbook_Open入口都写在了普通类模块里。普通类模块不会随加载项启动自动实例化，里面的Workbook_Open过程根本不会被Excel识别执行，事件绑定从第一步就失败了。
• 事件选的不对：你用的App_WorkbookOpen只在用户打开已有工作簿文件时触发，用户打开Excel自动新建空白工作簿、手动新建工作簿时都不会触发，完全覆盖不到你要的「只要开了Excel就生效」的场景。
• 路径硬写错误：代码里写死了C:\FilePath\Add-in.xlam的本地路径，但你的加载项是存在共享网盘上的，用户端根本不存在这个C盘路径，SetAttr从一开始就找不到目标文件。
• 逻辑顺序错误：等事件触发再去改文件属性的时候，用户端Excel早就以读写模式打开了加载项，共享盘的文件写锁已经被占用，这时候再改文件属性根本释放不了已经加上的锁，你还是没法编辑保存。
• 额外的逻辑坑：SetAttr是修改文件本身的系统只读属性，一旦执行成功，共享盘上的源文件会变成全局只读，到时候你自己也没法保存修改。

1. 删掉你之前在普通类模块里写的所有代码，把所有逻辑移到加载项的ThisWorkbook模块里——这是Excel加载项启动时唯一会自动执行Workbook_Open事件的模块。
2. 不要等用户打开其他工作簿再执行逻辑，加载项启动时就判断用户名，非授权用户直接将本地打开的加载项切换为只读模式，从根源上不占用共享盘的写锁，不要去改源文件的系统属性。

直接用下面的代码替换即可：

Private WithEvents App As Excel.Application
Const EDIT_ALLOWED_USER As String = "Andrew Lubrino"

Private Sub Workbook_Open()
    Set App = Application
    ' 启动即判断，无需等待打开其他工作簿
    If App.UserName <> EDIT_ALLOWED_USER Then
        Dim addinFullPath As String
        addinFullPath = ThisWorkbook.FullName ' 自动读取加载项当前的真实路径，无需硬写
        ' 关闭当前读写模式打开的加载项，不弹出保存提示
        ThisWorkbook.Close SaveChanges:=False
        ' 以只读模式重新打开加载项，不占用共享盘写锁
        Application.Workbooks.Open Filename:=addinFullPath, ReadOnly:=True
    End If
End Sub

' 兜底逻辑：防止加载项被意外切换为读写模式占锁
Private Sub App_WorkbookActivate(ByVal Wb As Workbook)
    If Wb.FullName = ThisWorkbook.FullName And App.UserName <> EDIT_ALLOWED_USER Then
        If Not ThisWorkbook.ReadOnly Then
            ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
        End If
    End If
End Sub

• 部署前确认所有用户的Excel宏设置允许加载项运行可信位置的宏，否则代码不会执行。
• 你自己打开共享盘上的加载项时会正常以读写模式加载，其他用户打开时会自动切换为只读模式，不会占用写锁，你随时可以修改保存代码，不需要通知用户关闭Excel。
• 不要用修改文件系统属性的方式实现只读，会把源文件锁死导致你自己也无法编辑。

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