VBA代码文件路径在macOS下报错问题求助

问题根源 #

macOS中Excel的CELL("filename")返回的路径是冒号分隔格式（例如Macintosh HD:Users:xxx:Documents:file.xlsx），而非Windows的反斜杠格式。你原代码中仅替换反斜杠为正斜杠，根本无法处理macOS的路径格式，导致Workbooks.Open解析失败。此外，创建新Excel实例再打开当前工作簿属于冗余操作，还可能引发权限或路径解析问题。

修正方案 #

1. 用VBA直接获取跨平台兼容路径 #

放弃工作表公式，改用VBA内置的ThisWorkbook.FullName属性获取当前工作簿完整路径——该属性会自动适配Windows和macOS的系统路径格式，无需手动转换。

2. 复用当前Excel实例 #

无需新建Excel.Application对象，直接使用当前运行代码的Excel实例，彻底规避跨实例的路径适配问题。

修改后的完整代码 #

Option Explicit

Sub Export()
    ' 声明变量
    Dim excelWorkbook As Workbook
    Dim excelWorksheet As Worksheet
    Dim wordApp As Object
    Dim wordDoc As Object
    Dim shapeNames As Variant
    Dim tableRanges As Variant
    Dim item As Variant
    
    ' 直接绑定当前工作簿，无需新建Excel实例
    Set excelWorkbook = ThisWorkbook
    Set excelWorksheet = excelWorkbook.Sheets("Questionnaire")
        
    ' 创建Word应用实例并新建文档
    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = True
    Set wordDoc = wordApp.Documents.Add
    
    ' 批量导出Results工作表中的形状
    Set excelWorksheet = excelWorkbook.Sheets("Results")
    shapeNames = Array("Group 2297", "Group 2363", "Group 2382", "Group 2400", "Group 2414")
    
    For Each item In shapeNames
        excelWorksheet.Shapes(item).Copy
        ' 第一个形状不插入新页，避免文档开头空白
        If item <> shapeNames(LBound(shapeNames)) Then
            wordApp.Selection.InsertNewPage
        End If
        wordApp.Selection.PasteSpecial DataType:=3 ' 粘贴为图片格式
        wordApp.Selection.Collapse Direction:=0
    Next item
    
    ' 批量导出Questionnaire工作表中的表格
    Set excelWorksheet = excelWorkbook.Sheets("Questionnaire")
    tableRanges = Array("Table1", "Table2", "Table3", "Table4")
    
    For Each item In tableRanges
        excelWorksheet.Range(item).Copy
        wordApp.Selection.Find.Execute "" ' 定位到文档末尾
        wordApp.Selection.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
    Next item
    
    ' 清理对象释放内存
    Set wordDoc = Nothing
    Set wordApp = Nothing
    Set excelWorksheet = Nothing
    Set excelWorkbook = Nothing
End Sub

额外优化说明 #

• 将重复的形状/表格操作改为循环，减少代码冗余，后续新增内容只需修改数组即可
• 优化分页逻辑，避免文档开头出现空白页
• 移除冗余的Excel实例创建，降低资源占用

若必须新建Excel实例的兼容处理 #

如果因特殊需求必须新建Excel实例，需针对macOS路径做格式转换：

Dim excelApp As Object
Dim FileName As String

If InStr(1, Application.OperatingSystem, "Windows") > 0 Then
    FileName = ThisWorkbook.FullName
Else
    ' macOS下将冒号路径转换为Unix风格正斜杠路径
    FileName = Replace(ThisWorkbook.FullName, ":", "/")
    ' 确保路径以斜杠开头
    If Left(FileName, 1) <> "/" Then
        FileName = "/" & FileName
    End If
End If

Set excelApp = CreateObject("Excel.Application")
Set excelWorkbook = excelApp.Workbooks.Open(FileName)

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