Reputation:
I've copied charts from excel to ppt and rearranged them in the slides. Now I'd like to save as pdf. My main problem is that it gives me an error "variable not defined" (ppFixedFormatTypePDF is highlighted) I've tried different options but none of them works. I know that the two loops could be merged to one, but I do not have the skills to do so. If you have an easy solution to this problem as well it is appreciated Thank you!
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
Upvotes: 0
Views: 1395
Reputation: 3387
According to this question, there is a bug involving ExportAsFixedFormat
method when used outside of PowerPoint so the alternative method is to use:
PPT.ActivePresentation.SaveAs strPath, 32
Where 32
is the value for ppSaveAsPDF
(documentation).
Upvotes: 2