Disclaimer- very new to writing VBA macros, but I have done a ton of research on here and other forums while trying to fix this error, all to no avail. Apologies if this has already been asked and answered, maybe I'm not searching correctly.
Now to the meat and potatos: I've been working on a VBA macro in Excel that will allow me to:
- Open a new or existing PowerPoint presentation
- Paste a value to, and activate, a specific cell, which in turn populates the spreadsheet using a vlookup formula
- Copy the values only from the first spreadsheet to a second one and then copy the second spreadsheet
- Make PowerPoint visible and then insert a new slide at a certain point
- Paste the Excel data to the new slide and position accordingly.
Whenever I run the macro with the PowerPoint presentation already open, it works perfectly. If I try to do it without the presentation open, it will prompt me to select the presentation file, open the PowerPoint, run the Excel functions, but then it hangs up when I try to make PowerPoint visible, add a slide, and paste the data. At Line 57 (pptApp.Visible = msoTrue) of the code below, the macro hangs and gives me the "Run-time error '91' Object variable or With block variable not set" message. I have been banging my head against this wall, but can't seem to find my error. Any help is appreciated.
Additionally, once this is working I plan to tweak it to create and insert a total of 25 slides. If anyone has ideas or advice on how I could do that with the first slide being created and added mid deck, and the following new slides continuing after, I'd love to hear it. Thanks!!
Main Routine:
Sub Final_Copy()
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptLayout As PowerPoint.CustomLayout
Dim pptShape As PowerPoint.Shape
Dim ws As Worksheet
Dim MyCell As Range, MyRange As Range
Dim rng As Excel.Range
Set rng = ThisWorkbook.ActiveSheet.Range("B1:I24")
Set MyRange = Sheets("Titles").Range("A2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
Set ws = ThisWorkbook.Sheets("PBAC")
On Error Resume Next
Set pptApp = GetObject(, "PowerPoint.Application")
Err.Clear
If pptApp Is Nothing Then SelectPresentationType.Show
On Error GoTo 0
For Each MyCell In MyRange
If MyCell.Value <> ("1100") Then
Sheets("Titles").Select
MyCell.Select
Selection.Copy
Sheets("PBAC").Select
Sheets("PBAC").Range("B25").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PBAC").Range("B25").Activate
With ws.UsedRange
.Copy
ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count), Count:=1, Type:=xlWorksheet
Sheets(Sheets.Count).Name = MyCell.Value
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
ActiveSheet.Rows("1").RowHeight = 44.25
ActiveSheet.Rows("2").RowHeight = 34.5
ActiveSheet.Rows("3").RowHeight = 18.75
ActiveSheet.Rows("4").RowHeight = 31.5
ActiveSheet.Rows("18").RowHeight = 31.5
ActiveSheet.Rows("5:17").RowHeight = 21.75
ActiveSheet.Rows("19:24").RowHeight = 21.75
ActiveWindow.DisplayGridlines = False
ActiveWindow.Zoom = 69
End With
Set rng = ThisWorkbook.ActiveSheet.Range("B1:I24")
pptApp.Visible = msoTrue
pptApp.Activate
Set pptPres = pptApp.ActivePresentation
Set pptLayout = pptPres.Slides(1).CustomLayout
Set pptSlide = pptPres.Slides.AddSlide(17, pptLayout)
rng.Copy
pptSlide.Shapes.PasteSpecial ppPasteEnhancedMetafile
Set pptShape = pptSlide.Shapes(pptSlide.Shapes.Count)
With pptShape
.LockAspectRatio = msoTrue
.Width = 725
.Height = 450
.Top = 55
.Left = 9
End With
Application.CutCopyMode = False
End If
Next MyCell
End Sub
Code for SelectPresentationType User Form used to select Existing or New Presentation:
Private Sub Create_New_Click()
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
SelectPresentationType.Hide
Set pptApp = CreateObject(class:="PowerPoint.Application")
pptApp.Visible = True
pptApp.Activate
Set myPresentation = pptApp.Presentations.Add
End Sub
Private Sub Existing_Presentation_Click()
Dim strFilePath As String
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
SelectPresentationType.Hide
strFilePath = Application.GetOpenFilename
If strFilePath = "False" Then Exit Sub
Set pptApp = New PowerPoint.Application
Set pptPres = pptApp.Presentations.Open(strFilePath)
pptApp.Visible = True
End Sub
GetObject
here. You've already declared the variable as a PowerPoint Application. You can either create a new instance of the Application object instead. That will fix your error. – Mr. Mascaro