问题
I am working on a custom tool that generates customized Instructor notes for a given presentation. I am having a problem where I am processing a presentation where a slide basically has no Title object on it Then I run through the code it is bi-passing my if statements with .
I have reduced the code to the basics to make it as easy as possible.
My test lesson has a normal slide with the text place holder filled out, the next slide is a logo slide with no title text box, just a copyright information and logo, (this is the slide that is having issues) and then another slide where the title place holder is present, but left blank.
How do I check the individual slide to make sure that the title placeholder exists?
Public Sub GetTitle()
Dim pres As Presentation 'PowerPoint presentation
Dim sld As Slide 'Individual slide
Dim shp As Shape 'EIAG Text Shape
Dim ShpType As String 'Shape Type
Dim SldTitle As String 'Slide TITLE
'Go through each slide object
Set pres = ActivePresentation
For Each sld In ActivePresentation.Slides.Range
On Error Resume Next
If sld.Shapes(1).PlaceholderFormat.Type = ppPlaceholderCenterTitle Or sld.Shapes(1).PlaceholderFormat.Type = ppPlaceholderTitle Then
If sld.Shapes.Title.TextFrame.TextRange <> "" Then
SldTitle = sld.Shapes.Title.TextFrame.TextRange
Debug.Print SldTitle & " - Slide: " & CStr(sld.SlideNumber)
Else
Debug.Print "BLANK TITLE - Slide: " & CStr(sld.SlideNumber)
End If
Else
ShpType = sld.Shapes.Item(1).Type
Debug.Print ShpType & "Not Processed There is no Title object"
End If
Next sld
End Sub
回答1:
You can use the HastTitle method of the Shapes Collection to check if a slide has a title placeholder:
If sld.Shapes.HasTitle then
You should also not rely on the title placeholder being shape 1 and rather loop through all shapes on the slide, checking each one as follows:
Option Explicit
' Function to return an array of title texts from a presentation
' Written by Jamie Garroch at http://youpresent.co.uk
' Inputs : None
' Outputs : Array of title strings
Function GetTitlesArr() As Variant
Dim oSld As Slide
Dim oShp As Shape
Dim iCounter As Integer
Dim arrTitles() As String
For Each oSld In ActivePresentation.Slides
For Each oShp In oSld.Shapes
With oShp
If .Type = msoPlaceholder Then
Select Case .PlaceholderFormat.Type
Case ppPlaceholderCenterTitle, ppPlaceholderTitle
ReDim Preserve arrTitles(iCounter)
arrTitles(iCounter) = oShp.TextFrame.TextRange.Text
iCounter = iCounter + 1
End Select
End If
End With
Next
Next
GetTitlesArr = arrTitles
End Function
来源:https://stackoverflow.com/questions/33509765/vba-powerpoint-slide-title