求助：实现Excel保存时自动导出PDF的VBA宏问题

你的这段代码能实现核心需求：在保存工作簿时生成同名PDF到同一目录，但存在几个潜在问题需要修复：

• 未保存的新工作簿会报错：如果是新建还未保存过的工作簿，ThisWorkbook.Path是空值，拼接出来的PDF路径会变成"\文件名.pdf"，直接触发运行错误。
• “另存为”场景不符合预期：当用户使用「另存为」功能时（SaveAsUI = True），用户可能修改保存路径或文件名，但你的代码依然用原路径和文件名生成PDF，导致PDF和新保存的Excel文件不同步。
• 缺少错误处理：如果PDF文件被占用、目标路径无写入权限等，会直接中断保存流程，没有任何提示。

优化后的代码 #

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim myPath As String
    Dim myFileName As String
    Dim fullExcelPath As String
    
    ' 处理未保存的工作簿：先引导用户完成保存
    If ThisWorkbook.Path = "" Then
        Cancel = True ' 取消当前事件触发
        Application.Dialogs(xlDialogSaveAs).Show ' 弹出保存对话框
        Exit Sub ' 保存完成后会再次触发BeforeSave，届时再生成PDF
    End If
    
    fullExcelPath = ThisWorkbook.FullName
    ' 提取文件路径和不带扩展名的文件名
    myPath = Left(fullExcelPath, InStrRev(fullExcelPath, "\"))
    myFileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
    
    On Error Resume Next ' 开启错误捕获
    ' 生成PDF，不自动打开
    ThisWorkbook.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        FileName:=myPath & myFileName & ".pdf", _
        OpenAfterPublish:=False
    
    ' 捕获错误并提示用户
    If Err.Number <> 0 Then
        MsgBox "PDF生成失败：" & Err.Description, vbExclamation
        Err.Clear
    End If
    On Error GoTo 0 ' 关闭错误捕获
End Sub

优化点说明 #

1. 处理未保存工作簿：先让用户完成第一次保存，避免空路径导致的错误。
2. 适配「另存为」场景：用户修改保存路径或文件名后，第二次触发BeforeSave事件时，会自动用新的路径和文件名生成PDF，保持和Excel文件同步。
3. 添加错误处理：捕获PDF生成时的异常，给出明确提示，不会中断Excel的保存流程。
4. 更严谨的路径提取：通过FullName属性配合InStrRev函数，更可靠地获取文件路径，避免手动拼接出错。

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