Question

我尝试将excel图表从特定工作表导出/打印到PDF。为此，我正在使用/调整此网站上发布的代码段（here）。如果我将图表复制/粘贴为“形状”，则图表会很好地打印到PDF，而不会重叠（example here）。

但是，我希望PDF可以搜索文本，并且Shapes打印为图像，而不是更复杂的对象。如果我打印ChartObjects，那么我得到一个可搜索的文本PDF，但由于某种原因，99％的时间，图表打印在彼此之上，而不是按顺序打印页面（example here）。

有谁知道为什么ChartObjects相互打印，以及如何防止这种情况发生？

Sub Sample(ByVal sName As String, ByRef ws As Worksheet, Optional bUseChartObj As Boolean = True)
'https://stackoverflow.com/questions/10497713/how-can-i-export-multiple-graphs-from-excel-to-a-single-pdf-using-vba
    
    Dim wsTemp As Worksheet
    Dim chObj As ChartObject
    Dim chrt As Shape
    Dim tp As Long
    Dim sFileName As String
    Dim i As Integer

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    sFileName = "C:\VP\" & sName & " _ " & ws.Name & ".pdf"
    'sFileName = "test.pdf"

    Set wsTemp = Sheets.Add

    tp = 10

    
    If bUseChartObj Then
    
        With wsTemp
            i = 1
            For Each chObj In ws.ChartObjects
                chObj.Copy
                wsTemp.Range("A1").Select
                wsTemp.Paste
                wsTemp.ChartObjects(i).Top = Range("A" & 1 + (i - 1) * 25).Top
                wsTemp.ChartObjects(i).Left = Range("A" & 1 + (i - 1) * 25).Left
                i = i + 1
            Next
        End With
        
    Else
        
        With wsTemp
            For Each chrt In ws.Shapes
                If chrt.Type = msoChart Then
                    chrt.Copy
                    wsTemp.Range("A1").PasteSpecial
                    Selection.Top = tp
                    Selection.Left = 5
                    tp = tp + Selection.Height + 50
                End If
            Next
        End With
    
    End If
    
    wsTemp.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFileName, Quality:=xlQualityStandard, _
           IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False

    Application.DisplayAlerts = False

LetsContinue:
    wsTemp.Delete
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
    
End Sub

将Excel图表打印为PDF

0 个答案: