Excel VBA公共变量传递及Worksheet_Change事件失效问题咨询

需求说明 #

• 工作簿打开时弹出用户窗体收集数据，数据既要用于填充表格，也要用来生成文件名
• 每当Sheet1被编辑时，自动按用户窗体生成的文件名保存文件

现存问题 #

1. ThisWorkbook中定义的SavePath变量无法传递到Sheet1的Worksheet_Change子程序，调试时MsgBox显示为空、Debug窗口无输出
2. 限制仅Sheet1触发保存事件的判断失效，编辑Sheet2时也会触发该事件

ThisWorkbook 代码 #

Option Explicit

Public SavePath As String
Public FileName As String
Public LotNumber As String
Public day As String
Public PartNumber As String
Public shift As String


Private Sub Workbook_Open()

Worksheets("template").Activate '若其他工作表打开，激活template工作表

Worksheets("template").Protect Password:="Bard", UserInterfaceOnly:=True '仅保护用户界面，允许VBA修改

UserForm1.Show

LotNumber = Worksheets("data").Range("A3").Value '从data表获取批号

day = Format(Date, "mm.dd.yy") '格式化当前日期

PartNumber = Worksheets("Data").Range("B3").Value '从data表获取零件号

shift = Worksheets("Data").Range("c3").Value '从data表获取班次

FileName = LotNumber & " " & day & " " & PartNumber & " " & shift '拼接文件名（批号+日期+零件号+班次）

SavePath = "C:\Users\lnieman\Desktop\Bard Echo PS Data Collection\" & FileName '设置桌面保存路径


End Sub

Sheet1 代码 #

Option Explicit

Public Sub Worksheet_Change(ByVal target As Range)

Dim WatchRange As Range
Dim WorkSheetTemplate As Worksheet


Set WorkSheetTemplate = ThisWorkbook.Sheets("sheet1")

If Me.Name = WorkSheetTemplate.Name Then
Set WatchRange = Me.Range("B3, D3, F3")

If Not Intersect(target, WatchRange) Is Nothing Then
Exit Sub
End If

'SavePath = ThisWorkbook.SavePath

Application.DisplayAlerts = False
  MsgBox "SavePath: " & SavePath

    ' 调试信息
    Debug.Print "SavePath before SaveAs: " & SavePath

ThisWorkbook.SaveAs FileName:=SavePath & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled '保存为启用宏的工作簿

 ' 调试信息
    Debug.Print "SavePath after SaveAs: " & SavePath

Application.DisplayAlerts = True
End If

End Sub

问题修复方案 #

问题1：SavePath变量传递失效 #

原因：Sheet1代码中注释掉了SavePath = ThisWorkbook.SavePath，导致Sheet1中使用的SavePath是未声明的局部变量，未获取到ThisWorkbook中定义的全局变量值；另外，执行SaveAs后工作簿状态改变，全局变量可能被重置。

修复步骤：

1. 取消Sheet1代码中SavePath = ThisWorkbook.SavePath的注释，直接获取全局变量值；
2. 更稳妥的方式：将SavePath存入隐藏工作表的单元格（避免保存后全局变量丢失），比如在ThisWorkbook的Workbook_Open末尾添加：

Worksheets("data").Range("D3").Value = SavePath '将路径存入data表D3单元格

然后在Sheet1中读取：

Dim SavePath As String
SavePath = Worksheets("data").Range("D3").Value

问题2：事件触发范围失效 #

原因：Worksheet_Change是工作表级事件，写在Sheet1模块中的该事件只会在Sheet1编辑时触发，原代码中的If Me.Name = WorkSheetTemplate.Name Then判断冗余，且可能因工作表实际名称与代码中"sheet1"不匹配导致逻辑失效。

修复步骤：

1. 删除Sheet1模块中多余的WorkSheetTemplate变量和名称判断语句；
2. 保留WatchRange的判断，确保指定单元格编辑时不触发保存；
3. 添加Application.EnableEvents = False避免保存操作触发循环事件。

修改后的Sheet1代码：

Option Explicit

Private Sub Worksheet_Change(ByVal target As Range)
    Dim WatchRange As Range
    Dim SavePath As String
    
    ' 方式1：读取全局变量
    SavePath = ThisWorkbook.SavePath
    ' 方式2：读取工作表存储的路径（更稳定）
    ' SavePath = Worksheets("data").Range("D3").Value
    
    Set WatchRange = Me.Range("B3, D3, F3")
    ' 若编辑的是指定范围单元格，直接退出
    If Not Intersect(target, WatchRange) Is Nothing Then Exit Sub
    
    ' 禁用事件避免循环触发
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Debug.Print "SavePath before SaveAs: " & SavePath
    ThisWorkbook.SaveAs FileName:=SavePath & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub

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