(Re-) Set a Table Style

Hello All,

I have decent skills with Excel macros, but with the new PowerPoint (>2013) I have to do it all by hand. 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 this forum and Google I have the following code

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
            .ParagraphFormat.SpaceAfter = 0
            .ParagraphFormat.SpaceBefore = 0
          End With
          With oTbl.Cell(lRow, lCol).Shape.TextFrame
            .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) 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) 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. No pattern I can determine as to when or when not it will work.
3) I need to reset the table margins, which I can do for the whole table (Select table -> Format Shape -> Size & Properties -> Text Box. I could not fine the equivalent to resetting the height for the minimum height (oSh.Height = 0), hence looping through the table.

Hopefully this group can help and thanks in advance

Michael Virostko

Hello,


Type Style has be fixed. The Boolean needs to be set to False

Code:

---

  If oSh.HasTable Then
      Set oTbl = oSh.Table
      oTbl.ApplyStyle ("{5C22544A-7EE6-4342-B048-85BDC9FD1C3A}"), False


---

Still looking for the solutions to slide resetting and setting the Table Margins and the vertical alignment to be a center (Currently done using the row and column loops). Really would like to eliminate this since I can manually do this.


Thanks.


Michael Virostko

Point 3

I still have not found out how to alter all the margins in a table without using the double loop to step through every cell (that works). But on the slide I can do the following:

Manually select the entire table on the slide.
Right click and select Format Shape.
Under the Size & Properties tab select Text Box.
Edit the margins and all the cells are modified (not just one).

There should be a way to the same operation via programming in VBA. If this is not possible I would like to know. Thanks.

To recap the other points

Point 1 - Reset the slide there are two solutions

Code:

---

Sub Reset_Slide()

Dim s As Slide

  Set s = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideIndex)
  s.Select
  s.CustomLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(15)
  DoEvents
  Application.CommandBars.ExecuteMso ("SlideReset")
  DoEvents

End Sub

---

or

Code:

---

Sub Reset_Slide2()

Dim s As Slide

  Set s = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideIndex)
  s.CustomLayout = s.CustomLayout

End Sub

---

Point 2 Table Reset

Code:

---

If oSh.HasTable Then
Set oTbl = oSh.Table
  oTbl.ApplyStyle ("{5C22544A-7EE6-4342-B048-85BDC9FD1C3A}"), False
End If

---

Michael Virostko

This can only be done in a loop as far as I know

Code:

---

Sub tbl()
Dim tbl As Table
Dim oshp As Shape
Dim iR As Integer
Dim iC As Integer
Set tbl = ActiveWindow.Selection.ShapeRange(1).Table
For iR = 1 To tbl.Rows.Count
For iC = 1 To tbl.Columns.Count
With tbl.Cell(iR, iC).Shape.TextFrame2
.MarginBottom = 0
.MarginLeft = 0
.MarginRight = 0
.MarginTop = 0
End With
Next
Next
End Sub

---