VBA调用「另存为」对话框将图表与单元格区域保存为PDF的实现问题

完整实现代码 #

你之前使用的xlDialogSaveAs是用来保存整个Excel工作簿的，导出PDF需要调整为路径选择后定向导出指定内容，修改后可用的代码如下：

Sub 导出指定内容到PDF()
    Dim savePath As Variant
    Dim exportRng As Range
    Dim shp As Shape
    Dim originalSelection As Range
    
    ' 记录用户当前选中的内容，导出完成后恢复
    Set originalSelection = Selection
    
    ' 弹出另存为对话框，限定仅能保存为PDF格式
    savePath = Application.GetSaveAsFilename( _
        FileFilter:="PDF文件 (*.pdf), *.pdf", _
        Title:="选择PDF保存位置")
    
    ' 用户点击取消则直接退出流程
    If savePath = False Then
        MsgBox "已取消导出", vbCritical
        Exit Sub
    End If
    
    ' ---------------以下内容请替换为你实际的导出范围---------------
    ' 1. 选中所有需要导出的单元格区域，多段不连续区域用英文逗号分隔
    Set exportRng = ThisWorkbook.Sheets("替换为你的工作表名称").Range("A1:C15,E1:G15") ' 示例范围，改成你截图里圈选的对应区域即可
    exportRng.Select
    
    ' 2. 追加选中需要导出的图表，仅导出指定图表可以修改判断条件
    For Each shp In ThisWorkbook.Sheets("替换为你的工作表名称").Shapes
        ' 如需仅导出指定图表，将判断条件改为 If shp.Name = "图表 1" Or shp.Name = "图表 2" Then 即可
        If shp.Type = msoChart Then
            shp.Select Replace:=False ' 不取消已选中的单元格，追加选中图表
        End If
    Next
    ' -----------------------------------------------------------
    
    ' 将选中的所有内容导出为PDF
    Selection.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=savePath, _
        Quality:=xlQualityStandard
    
    ' 恢复用户原本选中的内容
    originalSelection.Select
    
    MsgBox "PDF导出成功！", vbInformation
End Sub

使用说明 #

• 将代码里的替换为你的工作表名称修改为你实际要导出的工作表的名称
• 代码中Range参数内的区域可以根据你的需求随意调整，多段不相邻的区域直接用英文逗号分隔即可
• 如果需要调整导出内容的排版顺序、分页规则，可以提前在工作表的「页面布局」中设置打印区域和分页符，导出时会遵循设置生效
• 最后将这个宏绑定到你的按钮上即可正常使用

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