Powerpoint VBA Code

Finding documentation about how to write VBA code for MS Powerpoint is a challenge. When it comes to writing VBA macros most people think about number crunching with MS Excel first.

I got a presentation from our offering management containing RTC work item numbers and I wanted to write a VBA macro to extract those numbers ( to then run a RTC query to cross-check those work items in RTC itself ). Should be a piece of cake, shouldn’t it ? Well …

I bumped into some material here and here about the Powerpoint Object Model, but at the end this was not that helpful. At least it got me started, together with this article on Lifehacker how to loop through slides and shapes in a Powerpoint presentation.

I started to use the VBA Development Environment in Powerpoint and especially the Object Browser to discover what type of objects to use. I used a lot of intuition to go fishing in the sea of classes and members . At the end I figured it out, thus here is the code to get the job done and loop through all text in all table cells in all tables and look for digits of length 5 or 6:

Sub ExtractTextFromTableCells()

  Dim slide As Object
  Dim shape As Object
  Dim regEx As Object
  Dim strPattern As String: strPattern = "^\d{5,6}"
  Dim word As String
  Dim listOfIds As String
  listOfIds = ""
  Set regEx = CreateObject("vbscript.regexp")
  With regEx
        .Global = True
        .MultiLine = False
        .IgnoreCase = False
        .Pattern = strPattern
    End With
  Debug.Print "——————————————-"

  For Each slide In ActivePresentation.Slides
      For Each shape In slide.Shapes
          If shape.HasTable Then
              For Each Row In shape.Table.Rows
                For Each Cell In Row.Cells
                    txt = Cell.shape.TextFrame.TextRange.Text
                    If regEx.test(txt) Then
                        Dim WrdArray() As String
                        WrdArray() = Split(txt)
                        For i = LBound(WrdArray) To UBound(WrdArray)
                            Dim WrdArray2() As String
                            WrdArray2() = Split(WrdArray(i), ",")
                            For j = LBound(WrdArray2) To UBound(WrdArray2)
                                word = Replace(WrdArray2(j), " ", "")
                                word = Replace(word, "\n", "")
                                word = Replace(word, "|", "")
                                If regEx.test(word) And word <> "" Then
                                    listOfIds = listOfIds & word & ","
                                End If
                            Next j
                        Next i
                    End If
          End If
  Debug.Print listOfIds
End Sub

That script will return a comma separated list of RTC work item ids which can be easily used in a RTC query like so: