Grab All Slide Titles into an Array without Looping

[k64]

Hello, is there a way to grab all the slide titles from a presentation without looping? I'm running code from excel to move items between the two, and everything in powerpoint is really slow. Looping through the slides take a while, so I'd like to figure out how to speed it up, or limit my read/write operations. In excel, it is good coding practice to read and write from an entire range at once. Can this be done in powerpoint? If not, how can I make code execution on powerpoint from excel comparable in speed to when I run the code in powerpoint?

Here is my (unsuccessful) attempt:

Sub testr()Dim pptApp As PowerPoint.Application
Set pptApp = New PowerPoint.Application
Dim slidearr As Variant
With pptApp.Presentations("To Do List F14.pptm")
slidearr = .Slides.Range.Shapes(1).TextFrame.TextRange.Text
End With
End Sub

[John Wilson]

I think the only way is to loop. In any case Shapes(1) is not necessarily the title and slides may not even have a title and do not need to be unique.

In a loop you would need to check the .Shapes.HasTitle property and then look at .Shapes.Title.TextFrame.TextRange

If you are trying to identify a particular slide you might want to use the ID property rather than the title.

[Paul_Hossler]

I believe that you WILL have to have some kind of a loop, but I think that you can make it more efficient

You'll need to modify this to get it to work from Excel but I think it will be faster





Option Explicit
Sub drv()
Dim v As Variant
Dim i As Long

v = GetSlideTitles

For i = LBound(v) To UBound(v)
MsgBox i & " -- " & v(i)
Next i
End Sub

Function GetSlideTitles() As Variant
Dim oShape As Shape
Dim iSlideCounter As Long
Dim vTitles() As String

ReDim vTitles(1 To ActivePresentation.Slides.Count)

For iSlideCounter = 1 To ActivePresentation.Slides.Count
With ActivePresentation.Slides(iSlideCounter)

' Does the slide have title placeholder?
If .Shapes.HasTitle Then

' Get the reference to the title shape on the slide
Set oShape = .Shapes.Title

' Check if the placeholder has any text in it.
If Len(oShape.TextFrame.TextRange.Text) > 0 Then
vTitles(iSlideCounter) = oShape.TextFrame.TextRange.Text
End If

Else
vTitles(iSlideCounter) = "No Title"
End If
End With
Next iSlideCounter

GetSlideTitles = vTitles
End Function

[k64]

Thanks Paul_Hossler!

I modified your code, but I'm getting a type mismatch error on the line "Set oShape = .Shapes.Title". Do you know why? Here is the modified code:

Sub drv() Dim v As Variant
Dim i As Long
Dim pptApp As PowerPoint.Application
Set pptApp = New PowerPoint.Application
Dim pres As PowerPoint.Presentation
Set pres = pptApp.ActivePresentation
v = GetSlideTitles(pres)

For i = LBound(v) To UBound(v)
Debug.Print i & " -- " & v(i)
Next i
End Sub

Function GetSlideTitles(pres As Presentation) As Variant
Dim oShape As Shape
Dim iSlideCounter As Long
Dim vTitles() As String

ReDim vTitles(1 To pres.Slides.Count)

For iSlideCounter = 1 To pres.Slides.Count
With pres.Slides(iSlideCounter)

' Does the slide have title placeholder?
If .Shapes.HasTitle Then

' Get the reference to the title shape on the slide
Set oShape = .Shapes.Title

' Check if the placeholder has any text in it.
If Len(oShape.TextFrame.TextRange.Text) > 0 Then
vTitles(iSlideCounter) = oShape.TextFrame.TextRange.Text
End If

Else
vTitles(iSlideCounter) = "No Title"
End If
End With
Next iSlideCounter


GetSlideTitles = vTitles
End Function

I haven't been able to time your code yet, but currently, looping through the slides from excel using the code below is about 200 times slower than the same code run in powerpoint. I feel like there must be a way to do it faster.


Dim pptApp As PowerPoint.ApplicationSet pptApp = New PowerPoint.Application
Dim slidearr() As String
With pptApp.Presentations("To Do List F14.pptm")
t = Timer
ReDim slidearr(1 To .Slides.Count)
For x = 1 To .Slides.Count
slidearr(x) = .Slides(x).Shapes(1).TextFrame.TextRange
Next x
For x = 1 To UBound(dat, 1)
For y = 1 To UBound(slidearr)
If InStr(slidearr(y), dat(x, 1)) > 0 Then dat(x, 4) = y
Next y
Next x
Debug.Print "Code took " & Format(Timer - t, "0.000secs")
End With

[John Wilson]

If you declare oshape as Shape from Excel it will assume you mean an Excel shape.

Declare it as a PowerPoint.Shape

The loop will definitely be slow though. If you say why you need the titles there may be better ways.

[k64]

I'm trying to import a list of dated items from excel into a powerpoint, where each slide has a date in the title. In just excel, it would be no issue to cycle through each element of one list and compare it to each element of another list, and copy over if there was a match. This could be made even faster by doing all the operations in arrays and then pasting the entire array. For some reason, interfacing with powerpoint is making things slow, so that I can edit slides at a rate of about 10/second. With loops this can get large. Since the code runs quickly in powerpoint, I'm sure it must be something about going between, but I'm not sure how to speed it up.

[Paul_Hossler]

Well, I had a PP with 53 slides and this Excel macro ran < 1sec



Option Explicit
Sub drv()
Dim v As Variant
Dim i As Long
Dim pptApp As PowerPoint.Application
Set pptApp = New PowerPoint.Application
Dim pres As PowerPoint.Presentation
Set pres = pptApp.ActivePresentation
v = GetSlideTitles(pres)

For i = LBound(v) To UBound(v)
Debug.Print i & " -- " & v(i)
Next i
End Sub

Function GetSlideTitles(pres As PowerPoint.Presentation) As Variant
Dim oShape As PowerPoint.Shape
Dim iSlideCounter As Long
Dim vTitles() As String

ReDim vTitles(1 To pres.Slides.Count)

For iSlideCounter = 1 To pres.Slides.Count
With pres.Slides(iSlideCounter)

' Does the slide have title placeholder?
If .Shapes.HasTitle Then

' Get the reference to the title shape on the slide
Set oShape = .Shapes.Title

' Check if the placeholder has any text in it.
If Len(oShape.TextFrame.TextRange.Text) > 0 Then
vTitles(iSlideCounter) = oShape.TextFrame.TextRange.Text
End If

Else
vTitles(iSlideCounter) = "No Title"
End If
End With
Next iSlideCounter

GetSlideTitles = vTitles
End Function



12753


Did you check the PP object references in Excel?