Table formatting in PowerPoint using VBA

Question

I have decent skills with Excel macros, but with the new PowerPoint (>2013) I have to do it all by hand and many of the objects I can not find. I have to reformat PowerPoint slides (>150) and various tables. I need to reset the table to Medium Style 2 Accent 1, then change the column and row dimensions. I am using PowerPoint 2016.

With the help of various forums and Google I have the following code

Sub Reformat_slide ()

Dim s As Slide
Dim oSh As Shape
Dim oTbl As Table
Dim lRow As Long
Dim lCol As Long

  Set s = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideIndex)
  s.Select
  s.CustomLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(15)
'  Required to reset the slide format
  DoEvents
  Application.CommandBars.ExecuteMso ("SlideReset")
  DoEvents

  For Each oSh In s.Shapes
'  Force Title to a particular font,  setting the custom slide layout does not always  change it
    If Left(oSh.Name, 5) = "Title" Then
      With oSh.TextFrame.TextRange
        .Font.Name = "Tahoma(Header)"
        .Font.Size = 24
        .Font.Bold = False
      End With
    End If

'  Force Table for a specific format - Medium Style 2 Accent 1.
    If oSh.HasTable Then
      Set oTbl = oSh.Table
      oTbl.ApplyStyle ("{5C22544A-7EE6-4342-B048-85BDC9FD1C3A}"), True

      oSh.Height = 0
'
'       oSh.Left = InchesToPoints(.25)  is not working
      oSh.Left = 72 * 0.25
      oSh.Top = 72 * 1.3

      oTbl.Columns(1).Width = 72 * 1.3
      oTbl.Columns(2).Width = 72 * 3.55
      oTbl.Columns(3).Width = 72 * 1.3
      oTbl.Columns(4).Width = 72 * 1.1
      oTbl.Columns(5).Width = 72 * 2.25

      For lRow = 1 To oTbl.Rows.Count
        For lCol = 1 To oTbl.Columns.Count
          With oTbl.Cell(lRow, lCol).Shape.TextFrame.TextRange
            .Font.Name = "Tahoma(Body)"
            .Font.Size = 12
            .Font.Color = RGB(64, 65, 70)  ' Standard Light Green
            If lRow = 1 Or lCol = 1 Then .Font.Bold = True
            If lRow = 1 Then .ParagraphFormat.Alignment = ppAlignCenter
            .ParagraphFormat.SpaceAfter = 0
            .ParagraphFormat.SpaceBefore = 0
          End With
          With oTbl.Cell(lRow, lCol).Shape.TextFrame
            .VerticalAnchor = msoAnchorMiddle
            .MarginLeft = 72 * 0.05
            .MarginRight = 72 * 0.05
            .MarginTop = 72 * 0.04
            .MarginBottom = 72 * 0.04
          End With
       Next
      Next
    End If
  Next   ' Shape
End Sub

A few issue that I have.

1) Slide: Resetting the slide does not always work. No pattern I can determine as to when or when not it will work. Though manually it will always work.

2) Table Style: Resetting the table style does not always work. I literately have to create a new slide, a new table and copy and past the data. Again, If I reset the style manually (Select table, Table Tools Design Tab, select Table Style) it will reset properly. Usually what the borders stay black but they should be white after resettting.

3) Table Margin: I need to reset the table margins, which I can manually do for the whole table (Select table -> Format Shape -> Size & Properties -> Text Box). I could not determine the equivalent object in VBA hence the looping through the table. (I am looking to do something similar to resetting the height for the minimum height which is oSh.Height = 0).

4) Table Paragraph Alignment: Same issue with Table Margin. Need to set the Vertical alignment for Center and Horizontal for Center (Manually done via Select table -> Format Shape -> Size & Properties -> Text Box).

Hopefully this group can help and thanks in advance.

Michael Virostko

Answer 1

For slide resetting, the command you're using will work in some circumstances. Here's an alternate reset that will work in others, in practice, you may need to use either one:

s.CustomLayout = s.CustomLayout

Here's how to set the cell margins and alignment:

Sub FormatTable()
  Dim oTable As Table
  Dim oCell As Cell
  Dim ThisRow As Integer
  Set oTable = ActivePresentation.Slides(1).Shapes(1).Table
  For ThisRow = 1 To oTable.Rows.Count
    For Each oCell In oTable.Rows(ThisRow).Cells
      With oCell.Shape.TextFrame
        .MarginTop = 1
        .MarginRight = 1
        .MarginBottom = 1
        .MarginLeft = 1
        .HorizontalAnchor = msoAnchorCenter
        .VerticalAnchor = msoAnchorMiddle
      End With
    Next oCell
  Next ThisRow
End Sub