Consulting

Results 1 to 4 of 4

Thread: (Re-) Set a Table Style

  1. #1
    VBAX Newbie
    Joined
    Nov 2019
    Posts
    4
    Location

    (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


    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

  2. #2
    VBAX Newbie
    Joined
    Nov 2019
    Posts
    4
    Location
    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

  3. #3
    VBAX Newbie
    Joined
    Nov 2019
    Posts
    4
    Location
    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
    Last edited by mikejvir; 12-04-2019 at 10:16 AM. Reason: Correction to subroutine

  4. #4
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    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
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

Tags for this Thread

Posting Permissions

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