(Re-) Set a Table Style

[mikejvir]

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




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

[mikejvir]

Hello,


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




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

[mikejvir]

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



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



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



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

Michael Virostko

[John Wilson]

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



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