Results 1 to 2 of 2

Thread: Extracting PowerPoint Titles Into Excel

  1. #1
    VBAX Regular
    Feb 2021

    Extracting PowerPoint Titles Into Excel


    I don't know if this belongs here or in the PP subfora?

    I am looking for a code (in Excel) that can open up PowerPoint and loop through each slide to get the Titles. The goal is to make a list in Excel of EACH slide (=also the slides without a proper Title shape).

    Today we do this manually with a PP Module where we generate an Notepad.txt document from which we then Ctrl+C/V into our Excel.
    Why? The purpose of this exercise is to generate a Table of Contents of our Management Reporting presentation, where some of our Senior Management wants a hardcopy of the presentation with a TOC. And so far, this method has been the best used. In Excel we add the slide numbers from a "ROW()" formula. (Why it is important to also get slides without title)

    Our code in PowerPoint now is:

    Sub getTitles2()
     Dim PPSlide As Slide
     Dim sReport As String
     Dim iFilenum As Integer
     Dim FilePath As String
     For Each PPSlide In ActivePresentation.Slides
         If PPSlide.Shapes.HasTitle Then
             If PPSlide.Shapes.Title.TextFrame.HasText Then
                 sReport = sReport & PPSlide.Shapes.Title.TextFrame.TextRange & vbCrLf
                 sReport = sReport & "No title text" & vbCrLf
             End If
             sReport = sReport & "No title" & vbCrLf
         End If
     Next PPSlide
     iFilenum = FreeFile
     FilePath = Environ("TEMP") & "\data.txt"
     Open FilePath For Output As iFilenum
     Print #iFilenum, sReport
     Close iFilenum
     Call Shell("Notepad.exe " & FilePath, vbNormalFocus)
     End Sub
    In summary: Extract the titles and insert them into Sheet(x) starting from A1 and down.

    Is this possible?

    Best regards

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Jul 2008
    Here's some code I wrote recently for a church that uses PowerPoint for songs they sing. Naturally, as each song spans multiple slides, the same song title appears multiple times. Amongst other things, for my purposes the code automates Word rather than Excel and cleans up & formats both the output and titles themselves, as well as producing a sorted text file. For your purposes, you could use much the same code to automate Excel and do the sorting there without bothering with the text file. You may or may not want some of the other tweaks I mentioned.
    Sub GetTitles()
    Dim WdApp As New Word.Application, wdDoc As Word.Document, DataArray() As String
    Dim Sld As Slide, StrTmp As String, StrNms As String, StrFlNm As String
    StrFlNm = ActivePresentation.Path & "\Titles.txt"
    Set wdDoc = WdApp.Documents.Add
    For Each Sld In ActivePresentation.Slides
      With Sld
        If .Shapes.Count > 0 Then
          With .Shapes(1)
            If .Type = msoPlaceholder Then
              StrTmp = Trim(Replace(Split(Split(.TextFrame.TextRange.Text, vbCr)(0), Chr(11))(0), "  ", " "))
              If InStr(StrNms, StrTmp) = 0 Then
                wdDoc.Range.Text = StrTmp
                wdDoc.Range.Case = wdTitleWord
                StrTmp = wdDoc.Range.Text
                StrNms = StrNms & StrTmp
              End If
              If .TextFrame.TextRange.Text <> StrTmp Then .TextFrame.TextRange.Text = StrTmp
            End If
          End With
        End If
      End With
    StrNms = Left(StrNms, Len(StrNms) - 1)
    DataArray() = Split(StrNms, vbCr)
    WdApp.WordBasic.SortArray DataArray()
    wdDoc.Range.Text = Join(DataArray(), vbCr)
    wdDoc.SaveAs2 FileName:=StrFlNm, FileFormat:=wdFormatText, AddToRecentFiles:=False
    wdDoc.Close False: WdApp.Quit
    Set wdDoc = Nothing: Set WdApp = Nothing
    End Sub
    Paul Edstein
    [Fmr MS MVP - Word]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts