VBA代码保存PDF至文件同路径异常问题求助

核心问题 #

1. 未使用获取到的路径：你定义了saveLocation变量存储工作簿路径，但导出PDF时完全没用到它，直接用mappe作为文件名，Excel会默认存到系统预设路径（比如「我的文档」）。
2. 未处理未保存的工作簿：当Excel文件从未保存过，ActiveWorkbook.Path会返回空字符串，此时无法直接获取路径，必须先确保工作簿已保存。

修改后的代码 #

Sub Save_Mappe_As_pdf()
    '关闭后台提升运行速度
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
       
    Dim mappe As String
    mappe = Worksheets("Erfassen").Range("g2").Value '加上.Value更严谨
    
    Dim saveLocation As String
    Dim fullPdfPath As String
    
    '检查工作簿是否已保存
    If ActiveWorkbook.Path = "" Then
        '如果未保存，提示用户先保存文件
        MsgBox "请先保存当前Excel文件，否则无法将PDF保存到同一路径！", vbExclamation
        '可选：自动保存工作簿（如果需要，可取消下面注释并自定义文件名）
        'ActiveWorkbook.SaveAs Filename:="你的默认文件名.xlsx"
        GoTo Cleanup '直接跳转到恢复设置部分
    End If
    
    saveLocation = ActiveWorkbook.Path
    '拼接完整路径：路径 + 文件名 + .pdf后缀（避免文件名不含后缀的情况）
    fullPdfPath = saveLocation & "\" & mappe & ".pdf"
       
    Dim sheetArray As Variant
    sheetArray = Array("Druck", "Infozettel", "Kontrolle", "Beschriftungszettel")
    Sheets(sheetArray).Select
    
    '使用拼接好的完整路径导出PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fullPdfPath, OpenAfterPublish:=True

    Dim eingabe_sheet As Worksheet
    Set eingabe_sheet = Sheets("Eingabe")
    eingabe_sheet.Activate

Cleanup:
    '恢复系统设置
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

关键改动说明 #

• 路径拼接：将saveLocation和mappe拼接成完整的PDF路径，确保文件存到工作簿所在目录。
• 未保存判断：增加工作簿未保存时的提示，避免空路径导致的错误。
• 严谨性优化：读取单元格值时加上.Value，避免潜在类型问题；自动添加.pdf后缀，防止文件名缺失后缀。

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