Using excel I need to open PPT and create ".gif" image of a ."pdf" and save it-CodePudding

First let me explain what I am building. I have a folder that on a daily bases has 50-100 .pdf's added. Each .pdf has to be scanned and resaved with the file name being changed to show the work location and employee who completed it. The file then needs to be attach via a hyperlink to a object within a excel spreadsheet for tracking purposes. Because of the limitations at work from programming/security no .pdf can be opened from within excel VBA. This results in zero automation of the process and each file needing to be opened with adobe, reviewed, resaved, object created in the spreadsheet then hyperlinked individually. I am attempting to create a userform that will first iterate through the .pdf folder and saving a .gif image of each .pdf, then allow the user to review each .gif as a picture in a excel userform, then upon saving VBA will rename the file, create the object in the spreadsheet and attach the hyperlink. Below is the code I have for opening a new PPT, inserting a slide, then inserting the .pdf and finally resaving it as a .gif. I am getting a "Run time Error 438, Object does not support this property or method" on the "pagesetup.slidewidth". I have not worked with PPT for years and I am at a loss as to why excel won't except this syntac.

Option Explicit

Sub ConvertPDFtoGIF()

Dim OriginalPath As String
Dim NewPath As String
Dim NewPPT As Object
Dim PDFWidth As Single
Dim PDFHeight As Single
Dim sh As Shape

OriginalPath = "C:\Users\hareb\Desktop\Work Tracker\Test\3763A1010100003112022 - Copy (2).pdf"
NewPath = "C:\Users\hareb\Desktop\Work Tracker\Test\Test\TestGIF.GIF"

PDFWidth = 8.5
PDFHeight = 11

Set NewPPT = CreateObject("Powerpoint.application")

NewPPT.Visible = True
NewPPT.Presentations.Add

    With NewPPT.PageSetup
        .SlideWidth = PDFWidth
        .SlideHeight = PDFHeight
    End With

NewPPT.Slides.addslide 1, NewPPT.slidemaster.customlayouts(1)

Set sh = NewPPT.Slides(1).Shapes.AddOLEObject(0, 0, PDFWidth, PDFHeight, , OriginalPath)

Call NewPPT.Slides(1).Export(NewPath, "GIF")

End Sub

CodePudding user response：

Whether it's a bug in the OM or what, it seems happier if you get a reference to the Presentation as an object variable. Aircode to the extent that I didn't actually add the PDF ole object and export the slide as GIF, but the rest works:

Option Explicit

Sub ConvertPDFtoGIF()

Dim OriginalPath As String
Dim NewPath As String
Dim NewPPT As Object
Dim PDFWidth As Single
Dim PDFHeight As Single
Dim sh As Shape
' I added this
Dim PPTPres As Object

OriginalPath = "C:\Users\hareb\Desktop\Work Tracker\Test\3763A1010100003112022 - Copy (2).pdf"
NewPath = "C:\Users\hareb\Desktop\Work Tracker\Test\Test\TestGIF.GIF"

PDFWidth = 8.5
PDFHeight = 11

Set NewPPT = CreateObject("Powerpoint.application")

NewPPT.Visible = True

' get a reference to the presentation in PPTPres:
Set PPTPres = NewPPT.presentations.Add

' and use PPTPres to refer to the presentation and its
' properties/methods from here on:
PPTPres.Slides.AddSlide 1, PPTPres.SlideMaster.CustomLayouts(1)

    With PPTPres.PageSetup
        .SlideWidth = PDFWidth
        .SlideHeight = PDFHeight
    End With

Set sh = PPTPres.Slides(1).Shapes.AddOLEObject(0, 0, PDFWidth, PDFHeight, , OriginalPath)

Call PPTPres.Slides(1).Export(NewPath, "GIF")

End Sub

CodePudding user response：

Thank you Steve, that was exactly what I needed. I was able to tweak the code and it works great know. Here is the final code:

Sub ConvertPDFtoGIF()

Dim OriginalPath As String
Dim NewPath As String
Dim NewPPT As Object
Dim PDFWidth As Single
Dim PDFHeight As Single
Dim sh As Object
Dim PPTPres As Object

OriginalPath = "C:\Users\hareb\Desktop\Work Tracker\Test\3763A1010100003112022 - Copy (2).pdf"
NewPath = "C:\Users\hareb\Desktop\Work Tracker\Test\Test\TestGIF.GIF"

PDFWidth = 8.5 * 72
PDFHeight = 11 * 72

Set NewPPT = CreateObject("Powerpoint.application")

NewPPT.Visible = True

Set PPTPres = NewPPT.presentations.Add

PPTPres.Slides.AddSlide 1, PPTPres.SlideMaster.CustomLayouts(1)

    With PPTPres.PageSetup
        .SlideWidth = PDFWidth
        .SlideHeight = PDFHeight
    End With

Set sh = PPTPres.Slides(1)

sh.Shapes.AddOLEObject 0, 0, PDFWidth, PDFHeight, , OriginalPath


Call PPTPres.Slides(1).Export(NewPath, "GIF")

NewPPT.Quit

End Sub