CODEWITHSUNDEEP
excelvba
Gerald Tao
Gerald Tao

Reputation: 31

Trying to copy Slide Title from PowerPoint to excel

I'm still pretty new to excel VBA and I want to copy the slide title from ALL the Slides from PPT to Excel (paste, then go to next row and paste)

But currently, I can only come out with the following codes that seem really stupid. Would appreciate if anyone can simplify my codes so that when there are 100+ slides, I don't have to repeat so many lines of codes

Sub CopySlideTitle()
'Stupid way of doing things
Dim ppt As PowerPoint.Application
Set ppt = New PowerPoint.Application
ppt.Visible = msoTrue
ppt.Presentations.Open ("C:\Users\geral\Desktop\Test.pptm")
Dim ppPres As PowerPoint.Presentation
Set ppPres = ppt.ActivePresentation

Dim ppSlide As Slide


Dim SlideText01 As String, SlideText02 As String, SlideText03 As String, _
SlideText04 As String, SlideText05 As String, SlideText06 As String, _
SlideText07 As String, SlideText08 As String, SlideText09 As String, _
SlideText10 As String

SlideText01 = ppPres.Slides(1).Shapes("SlideTitle").TextFrame.TextRange.Text
SlideText02 = ppPres.Slides(2).Shapes("SlideTitle").TextFrame.TextRange.Text
SlideText03 = ppPres.Slides(3).Shapes("SlideTitle").TextFrame.TextRange.Text
SlideText04 = ppPres.Slides(4).Shapes("SlideTitle").TextFrame.TextRange.Text
SlideText05 = ppPres.Slides(5).Shapes("SlideTitle").TextFrame.TextRange.Text
SlideText06 = ppPres.Slides(6).Shapes("SlideTitle").TextFrame.TextRange.Text
SlideText07 = ppPres.Slides(7).Shapes("SlideTitle").TextFrame.TextRange.Text
SlideText08 = ppPres.Slides(8).Shapes("SlideTitle").TextFrame.TextRange.Text
SlideText09 = ppPres.Slides(9).Shapes("SlideTitle").TextFrame.TextRange.Text
SlideText10 = ppPres.Slides(10).Shapes("SlideTitle").TextFrame.TextRange.Text

Range("A1").Value = SlideText01
Range("A2").Value = SlideText02
Range("A3").Value = SlideText03
Range("A4").Value = SlideText04
Range("A5").Value = SlideText05
Range("A6").Value = SlideText06
Range("A7").Value = SlideText07
Range("A8").Value = SlideText08
Range("A9").Value = SlideText09
Range("A10").Value = SlideText10

End Sub

Thanks millions in advance

Upvotes: 0

Views: 1272

Answers (1)

Domenic
Domenic

Reputation: 8124

You can loop through each slide as follows...

Sub CopySlideTitle()

    Dim ppApp As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    Dim ppSlide As PowerPoint.Slide
    Dim oRow As Long

    Set ppApp = New PowerPoint.Application
    ppApp.Visible = msoTrue

    Set ppPres = ppApp.Presentations.Open("C:\Users\geral\Desktop\Test.pptm")

    oRow = 1
    For Each ppSlide In ppPres.Slides
        Cells(oRow, "A").Value = ppSlide.Shapes("SlideTitle").TextFrame.TextRange.Text
        oRow = oRow + 1
    Next ppSlide

End Sub

However, here's another way. This approach loops through each slide, then loops through each place holder in the slide, then checks whether the place holder is a title, and then retrieves its text.

Sub CopySlideTitle()

    Dim ppApp As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    Dim ppSlide As PowerPoint.Slide
    Dim ppPlaceHolder As PowerPoint.Shape
    Dim oRow As Long

    Set ppApp = New PowerPoint.Application
    ppApp.Visible = msoTrue

    Set ppPres = ppApp.Presentations.Open("C:\Users\geral\Desktop\Test.pptm")

    oRow = 1
    For Each ppSlide In ppPres.Slides
        For Each ppPlaceHolder In ppSlide.Shapes.Placeholders
            If ppPlaceHolder.PlaceholderFormat.Type = ppPlaceholderTitle Then
                Cells(oRow, "A").Value = ppPlaceHolder.TextFrame.TextRange.Text
                oRow = oRow + 1
                Exit For
            End If
        Next ppPlaceHolder
    Next ppSlide

End Sub

Also, if you want to include the title from the Title page, you'll need to replace...

If ppPlaceHolder.PlaceholderFormat.Type = ppPlaceholderTitle Then

with

If ppPlaceHolder.PlaceholderFormat.Type = ppPlaceholderCenterTitle Or _
                ppPlaceHolder.PlaceholderFormat.Type = ppPlaceholderTitle Then

Hope this helps!

Upvotes: 0

Related Questions