Windows正常运行的VBA存PDF代码在MacOS报错求助

问题根源 #

你的代码在MacOS上失效核心原因如下：

• 硬编码固定路径：Mac分支写死了/Users/username/Desktop/，没有动态获取当前登录用户，导致路径无效
• 缺失目录创建逻辑：Mac端未调用目录创建代码，若目标路径不存在会直接触发保存失败
• 跨平台API与路径不兼容：原CreateDir函数依赖Windows双反斜杠分隔符，Mac使用正斜杠；且Mac的Dir、MkDir函数行为与Windows存在差异
• 选区操作不稳定：依赖Select、ActiveCell的操作在Mac上可能因窗口焦点问题失效

修复方案 #

1. 动态获取跨平台路径

• Windows用Environ("username")拼接用户目录
• Mac用Environ("HOME")获取当前用户主目录，再拼接桌面路径

2. 适配跨平台的目录创建函数

重写CreateDir，自动识别系统路径分隔符，同时处理Mac上Dir函数的返回逻辑，添加错误捕获避免权限问题

3. 替换选区操作为非激活引用

去掉Activate、Select操作，直接通过工作表对象引用单元格区域，提升跨平台稳定性

4. 统一路径格式

根据系统自动切换正斜杠/反斜杠，确保路径格式符合系统要求

修正后的完整代码 #

Sub SaveSelectionAsPDF()
    Dim saveLocation As String
    Dim CheckOS As String, PoNumber As String
    Dim saveDirectory As String
    Dim wsFormatted As Worksheet, wsSheet As Worksheet
    Dim lastRow As Long, i As Long
    
    ' 直接绑定工作表对象，避免Activate/Select操作
    Set wsFormatted = ThisWorkbook.Worksheets("PO_Formatted")
    Set wsSheet = ThisWorkbook.Worksheets("PO_Sheet")
    
    CheckOS = Application.OperatingSystem
    PoNumber = wsFormatted.Cells(11, 3).Value
    
    ' 跨平台路径适配
    If InStr(1, CheckOS, "Windows") > 0 Then
        saveDirectory = "C:\Users\" & Environ("username") & "\Desktop\PO Sheets\" & Format(Date, "dd-mmm-yyyy") & "\"
        saveLocation = saveDirectory & PoNumber & ".pdf"
    Else
        saveDirectory = Environ("HOME") & "/Desktop/PO Sheets/" & Format(Date, "dd-mmm-yyyy") & "/"
        saveLocation = saveDirectory & PoNumber & ".pdf"
    End If
    
    ' 创建目标目录（兼容跨平台）
    Call CreateDir(saveDirectory)
    
    ' 获取导出区域并导出PDF（非激活式引用）
    lastRow = wsFormatted.Range("B1000").End(xlUp).Row
    With wsFormatted.Range(wsFormatted.Cells(lastRow + 1, 1), wsFormatted.Cells(1, 10))
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveLocation, OpenAfterPublish:=True
    End With
    
    ' 更新PO确认状态
    For i = 4 To wsSheet.UsedRange.Rows.Count
        If wsSheet.Cells(i, 4).Value = PoNumber Then
            wsSheet.Cells(i, 21).Value = "Confirmed"
        End If
    Next i
End Sub

Sub CreateDir(strPath As String)
    Dim elm As Variant
    Dim strCheckPath As String
    Dim pathSeparator As String
    
    ' 根据系统自动选择路径分隔符
    pathSeparator = IIf(InStr(1, Application.OperatingSystem, "Windows") > 0, "\", "/")
    
    strCheckPath = ""
    ' 按分隔符拆分路径并逐级创建
    For Each elm In Split(strPath, pathSeparator)
        If elm <> "" Then
            strCheckPath = strCheckPath & elm & pathSeparator
            ' 检查目录是否存在，不存在则创建（添加错误捕获处理权限问题）
            If Len(Dir(strCheckPath, vbDirectory)) = 0 Then
                On Error Resume Next
                MkDir strCheckPath
                On Error GoTo 0
            End If
        End If
    Next
End Sub

额外注意事项 #

• 去掉所有Activate和Select操作后，代码稳定性大幅提升，避免跨平台下的焦点冲突
• 目录创建函数添加了错误捕获，可避免因权限不足导致的崩溃
• Mac上需确保目标路径（桌面文件夹）有写入权限，若仍报错可检查系统权限设置

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