Getting the error below when trying to change text in a text box on my slideshow.
Essentially I am doing the following
- Using excel to pull two things, a TITLE, and a TAG
- I then open two powerpoints. pres1 is my master deck, pres2 is the deck that is created for each unique "case"
- If the tag pulled from excel matches a slide name in pres1, it is copied into pres2
- if that tag IS NOT found, I copy a template slide from pres1, add it to the end of the presentation (that works)
- Last bit of business is to edit the text in that newly created slide to the string DSSTitle
- See my comments below for where the error below pops up.
Any help would be appreciated
Code:
Option Explicit
Sub CreatePPTSlidesDrew()
Dim CustRow, CustCol, FinalCol, TitleRow As Long
Dim PPTLoc, TagName, TagRow, FileName, TempFileName, ReviewLoc, WebsiteURL, sSlideName, DSSTitle, SlideCount As String
Dim PPTApp As PowerPoint.Application
Dim pres1, pres2 As PowerPoint.Presentation
Dim oSl As Slide
Dim objSlide As Slide
Dim pp As Object
Dim objTextBox As Shape
TempFileName = ThisWorkbook.Sheets("DSSWorksheet").Range("comp")
Set pp = CreateObject("PowerPoint.Application")
With ThisWorkbook.Sheets("ReviewContent")
PPTLoc = "C:\ppt-test\SEE.pptm" 'PPT location
On Error Resume Next 'If PPT is already running
On Error GoTo 0 '~~ reset error handling
Set pres1 = pp.Presentations.Open(FileName:=PPTLoc, ReadOnly:=False) 'Open Template
Set pres2 = pp.Presentations.Add ' Create new file
If pp.Version >= 9 Then
'window must be visible
pp.Visible = msoTrue
End If
CustRow = 17 'Row for review content for PPT files'
TagRow = CustRow - 1
TitleRow = CustRow - 3
FinalCol = .Cells(CustRow, .Columns.Count).End(xlToLeft).Column
For CustCol = 2 To FinalCol 'Move Through All Data
TagName = .Cells(TagRow, CustCol).Value 'Tag Name
DSSTitle = .Cells(TitleRow, CustCol).Value 'Title Name
ReviewLoc = .Cells(CustRow, CustCol).Value 'Review Location
On Error GoTo dss
If ReviewLoc Like "C*" Then
On Error Resume Next
Set oSl = pres1.Slides(TagName)
If Err.Number = 0 Then ' if no error, there's a slide by that name TagName in the main PPT Template
pres1.Slides(TagName).Copy
pres2.Slides.Paste pres2.Slides.Count + 1
Else ' slide will be created in the main PPT template'
pres1.Slides("||templateslide||").Copy
pres1.Slides.Paste pres1.Slides.Count + 1
SlideCount = pres1.Slides.Count
MsgBox "Slide should have copied, and there are this many slides " & SlideCount 'This slide count does come back correctly
On Error GoTo 0
' THE FOLLOWING LINE IS WHERE THE ERROR HAPPENS TELLING ME THERE ARE NOT 9 SLIDES IN THE PPT
Set objSlide = pres1.Slides(SlideCount)
objSlide.Name = TagName
MsgBox "Slide renamed to '" + TagName + "'."
Set objTextBox = objSlide.Shapes.Item(1)
objTextBox.TextFrame.TextRange.Text = DSSTitle
End If
End If
dss:
Next CustCol
FileName = ThisWorkbook.Path & "\" & TempFileName & "-" & "PowerPoint" & Format(Now, "_mmddyyyy") & ".pptx"
pres2.SaveAs FileName 'This is where the new template is created
PPTApp.Visible = True 'Make the application visible to the user
PPTApp.Activate
pres2.Save
pres1.Close
End With
End Sub