使用 VBA 将 PPT 另存为 pdf

Question

我已将图表从 excel 复制到 ppt 并在幻灯片中重新排列它们。现在我想另存为pdf。我的主要问题是它给我一个错误“变量未定义”（突出显示 ppFixedFormatTypePDF）我尝试了不同的选项，但其中 none 有效。我知道这两个循环可以合并为一个，但我没有这样做的技能。如果您也有解决此问题的简单方法，我们将不胜感激谢谢！

Option Explicit

Sub CopyToPPT()

Dim PPT As Object
Dim chr
Set PPT = CreateObject("Powerpoint.Application")
PPT.Visible = True
PPT.Presentations.Open Filename:="H:\VBA Projects\EXC\test.ppt"

Const START_LEFT_POS As Long = 95
Const START_TOP_POS As Long = 5
Const GAP As Long = 5 'gap between charts

Dim LeftPos As Long
LeftPos = START_LEFT_POS

Dim TopPos As Long
TopPos = START_TOP_POS

Dim NextSlideIndex As Long
NextSlideIndex = 2
Dim NextSlideIndex2 As Long
NextSlideIndex2 = 3

PPT.ActivePresentation.Slides.Range(Array(2, 3)).Delete
PPT.ActivePresentation.Slides(2).Copy
PPT.ActivePresentation.Slides.Paste Index:=3

PPT.ActiveWindow.View.GotoSlide NextSlideIndex
    
With Sheets("Output")
        Dim ChrtIndex As Long
        For ChrtIndex = 1 To .ChartObjects.Count
            .ChartObjects(ChrtIndex).Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
            PPT.ActiveWindow.View.Paste
            With PPT.ActiveWindow.View.slide
                With .Shapes(.Shapes.Count)
                    .Left = LeftPos
                    .Top = TopPos
                    .Width = 160
                    .Height = 155
                    If ChrtIndex Mod 2 = 1 Then
                        LeftPos = LeftPos + .Width + GAP
                    Else
                        LeftPos = START_LEFT_POS
                        TopPos = TopPos + .Height + GAP
                    End If
                End With
            End With
            If ChrtIndex Mod 4 = 0 Then
                LeftPos = START_LEFT_POS
                TopPos = START_TOP_POS
                NextSlideIndex = NextSlideIndex + 1
                PPT.ActiveWindow.View.GotoSlide NextSlideIndex
            End If
        Next ChrtIndex
End With


With Sheets("Uddybet")
        Dim ChrtIndex2 As Long
        For ChrtIndex2 = 1 To .ChartObjects.Count
            .ChartObjects(ChrtIndex2).Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
            PPT.ActiveWindow.View.Paste
            With PPT.ActiveWindow.View.slide
                With .Shapes(.Shapes.Count)
                    .Left = LeftPos
                    .Top = TopPos
                    .Width = 160
                    .Height = 155
                    If ChrtIndex2 Mod 2 = 1 Then
                        LeftPos = LeftPos + .Width + GAP
                    Else
                        LeftPos = START_LEFT_POS
                        TopPos = TopPos + .Height + GAP
                    End If
                End With
            End With
            If ChrtIndex Mod 4 = 0 Then
                LeftPos = START_LEFT_POS
                TopPos = START_TOP_POS
                NextSlideIndex2 = NextSlideIndex2 + 1
                PPT.ActiveWindow.View.GotoSlide NextSlideIndex2
            End If
        Next ChrtIndex2
End With

'Save as pdf
Dim dt As String
Dim strPath As String
dt = Format(CStr(Now), "yyyy_mm_dd_hh_mm")

'ActivePresentation.ExportAsFixedFormat "H:\VBA Projects\EXC\test_" & dt & ".pdf", ppFixedFormatTypePDF

strPath = "H:\VBA Projects\EXC\test_" & dt & ".pdf"

ActivePresentation.ExportAsFixedFormat Path:=strPath, FixedFormatType:=ppFixedFormatTypePDF

'Dim dt As String
'dt = Format(CStr(Now), "yyyy_mm_dd_hh_mm")
'        PPT.ExportAsFixedFormat ActivePresentation.Path & "\" & test & dt & ".pdf", ppFixedFormatTypePDF, ppFixedFormatIntentPrint

End Sub

Answer 1

根据此 question，在 PowerPoint 外部使用时存在涉及 ExportAsFixedFormat 方法的错误，因此替代方法是使用：

PPT.ActivePresentation.SaveAs strPath, 32

其中 32 是 ppSaveAsPDF (documentation) 的值。

使用 VBA 将 PPT 另存为 pdf

Save PPT as pdf using VBA

pdf

excel

powerpoint

vba