带附加数据模型的数据透视表：如何支持终端用户修改文件路径/名称

终端用户将模板文件从团队文件夹复制到客户文件夹或重命名后，原宏因硬编码文件路径和名称无法正常运行，以下是无需手动调整代码即可适配的解决方案：

核心修改思路 #

• 用ThisWorkbook替代硬编码的工作簿名称：ThisWorkbook始终指向包含当前宏代码的工作簿，不受文件移动、重命名影响。
• 动态生成连接字符串中的文件路径：通过ThisWorkbook.FullName获取当前文件的完整路径，自动替换硬编码的固定路径。
• 修正Range引用的潜在问题：确保所有Range对象都明确指定所属工作表，避免跨表引用错误。

修改后的完整代码 #

Dim NewScenario As Worksheet
Dim RangeForPivot As Range
Dim connName As String
Dim fullFilePath As String

Set NewScenario = Sheets(ActiveSheet.Index)
' 修正Range引用，明确指定目标工作表
Set RangeForPivot = NewScenario.Range("A3", NewScenario.Range("A3").End(xlToRight).End(xlDown).End(xlDown).Offset(-1))

' 生成唯一连接名称，避免重复
connName = "ScenarioConnection_" & NewScenario.Name & "!" & RangeForPivot.Address
' 获取当前文件的完整路径（含文件名）
fullFilePath = ThisWorkbook.FullName

' 创建动态连接，替换硬编码路径
ThisWorkbook.Connections.Add2 _
    connName, "", _
    "WORKSHEET;" & fullFilePath & "!" & NewScenario.Name, _
    NewScenario.Name & "!" & RangeForPivot.Address, 7, True, False

' 创建数据透视表，引用当前工作簿的动态连接
ThisWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:= _
        ThisWorkbook.Connections(connName), Version:=8).CreatePivotTable TableDestination:= _
        NewScenario.Name & "!R100C42", TableName:="ScenarioPIVOT", DefaultVersion:=8

关键修改点说明 #

1. ThisWorkbook的使用：全程替换原代码中硬编码的工作簿名称和ActiveWorkbook，确保始终引用宏所在的当前工作簿，避免因激活其他工作簿导致的错误。
2. 动态路径生成：fullFilePath = ThisWorkbook.FullName自动获取当前文件的完整路径，不管文件移动到哪个文件夹或重命名，都能正确生成连接字符串。
3. Range引用修正：将原代码中的Range("A3")改为NewScenario.Range("A3")，确保引用的是目标工作表中的单元格，避免因当前激活工作表不同导致的范围错误。
4. 连接名称复用：将连接名称存入变量connName，避免重复拼接字符串，提升代码可读性和维护性。

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