Search code examples
vbapowerpoint

Powerpoint table formatting; last row borders not styled


I'm trying to format the selected table with a colorless first row with a bottom border, interlined light grey rows, and the last row with top and bottom borders.

Everything seems to be working fine except with the last row's top and bottom borders not being styled correctly.

Can you help me fix the problem?

Thanks in advance!

Here's the code:

Sub FormatShape()
Dim oSlide As slide
Dim oShape As Shape
Dim oTable As Table
Dim oCell As cell

Dim iRow As Long
Dim iCol As Long

Set oSlide = Application.ActiveWindow.View.slide
Set oShape = ActiveWindow.Selection.ShapeRange(1)

RowTotal = True

If Not oShape.HasTable Then
    MsgBox "Please select a table and try again."
Else
    Set oTable = oShape.Table
    For iRow = 1 To oTable.Rows.Count
        For iCol = 1 To oTable.Columns.Count
            With oTable.cell(iRow, iCol)
            
                With .Shape.TextFrame.textRange
                    .Font.Name = "Graphik LCG"
                    .Font.size = 10
                    .Font.Color.RGB = vbBlack
                    .Font.Bold = True
                End With
               
                If iRow = 1 Then
                    With oTable.cell(iRow, iCol)
                        .Shape.Fill.ForeColor.RGB = vbWhite
                    
                        With .Borders(ppBorderTop)
                            .ForeColor.RGB = vbWhite
                            .Visible = False
                            .Weight = 1
                            .Transparency = 1
                        End With
                        
                        With .Borders(ppBorderLeft)
                            .ForeColor.RGB = vbWhite
                            .Visible = False
                            .Weight = 1
                            .Transparency = 1
                        End With
                        
                        With .Borders(ppBorderBottom)
                            .Visible = True
                            .ForeColor.RGB = vblack
                            .Weight = 1
                        End With
                        
                        With .Borders(ppBorderRight)
                            .Visible = False
                            .ForeColor.RGB = vbBlack
                            .Weight = 1
                            .Transparency = 1
                        End With
                    End With
                Else
                    .Shape.TextFrame.textRange.Font.Bold = False
                        
                    ' check if odd number
                    If Not iRow Mod 2 <> 0 Then
                        .Shape.Fill.ForeColor.RGB = RGB(235, 235, 235)
                    Else
                        .Shape.Fill.ForeColor.RGB = vbWhite
                    End If
                                        
                    With oTable.cell(iRow, iCol)
                 
                        With .Borders(ppBorderLeft) 'Left
                            .Visible = msoFalse
                            .ForeColor.RGB = vbWhite
                            .Weight = 1
                            .Transparency = 1
                        End With
                        
                        With .Borders(ppBorderBottom) 'Bottom
                            .Visible = msoTrue
                            .ForeColor.RGB = vbWhite
                            .Weight = 1
                            .Transparency = 1
                        End With
                        
                        With .Borders(ppBorderRight) 'Right
                            .Visible = msoFalse
                            .ForeColor.RGB = vbWhite
                            .Weight = 1
                            .Transparency = 1
                        End With
                    
                        If iRow = oTable.Rows.Count - 1 Then
                    
                            With .Borders(ppBorderBottom)
                                .Visible = True
                                .ForeColor.RGB = vblack
                                .Weight = 1
                            End With
                        End If
                        
                        If iRow = oTable.Rows.Count Then
                            MsgBox "here"
                            With .Borders(ppBorderTop)
                                .Visible = True
                                .ForeColor.RGB = vblack
                                .Weight = 1
                            End With
                            
                            With .Borders(ppBorderBottom)
                                .Visible = True
                                .ForeColor.RGB = vblack
                                .Weight = 1
                            End With

                            
                            oTable.cell(iRow, iCol).Shape.TextFrame.textRange.Font.Bold = True
                                                        
                        End If
                        
                        End With
                            
                    End If
                
            End With
        Next
    Next
End If
End Sub

Solution

  • The best way to do this is to edit the presentation XML to create a custom table style. Then you would have a table where you could use the program interface to switch the header and total rows and the banding on and off, just like a real PowerPoint table.

    Editing XML is very similar to editing HTML. Here are my articles on how to do this: OOXML Hacking: Custom Table Styles OOXML Hacking: Table Styles Complete OOXML Hacking: Default Table Text

    But since you got started on doing this with VBA, let's finish the task. Your code had a bunch of mistakes, but the main issue with tables is that the top border of the bottom row doesn't just belong to the bottom row. It's also the bottom border of the row second from the bottom.

    This code sets both the bottom border of the second last row, and the top border of the last row. It's working here:

    Sub FormatTable()
        Dim oShape As Shape
        Dim oTable As Table
        Dim oCell As Cell
        Dim iRow As Long
        Dim iCol As Long
        
        Set oShape = ActiveWindow.Selection.ShapeRange(1)
        RowTotal = True
        
        If Not oShape.HasTable Then
            MsgBox "Please select a table and try again."
        Else
            Set oTable = oShape.Table
            For iRow = 1 To oTable.Rows.Count
                For iCol = 1 To oTable.Columns.Count
                    With oTable.Cell(iRow, iCol)
                        With .Shape.TextFrame.TextRange
                            .Font.Name = "Graphik LCG"
                            .Font.Size = 10
                            .Font.Color.RGB = RGB(0, 0, 0)
                            .Font.Bold = True
                        End With
                        If iRow = 1 Then
                            'Format first row
                            With oTable.Cell(iRow, iCol)
                                .Shape.Fill.ForeColor.RGB = RGB(255, 255, 255)
                                With .Borders(ppBorderTop)
                                    .ForeColor.RGB = RGB(255, 255, 255)
                                    .Visible = False
                                    .Weight = 1
                                    .Transparency = 1
                                End With
                                With .Borders(ppBorderLeft)
                                    .ForeColor.RGB = RGB(255, 255, 255)
                                    .Weight = 1
                                    .Transparency = 1
                                End With
                                With .Borders(ppBorderBottom)
                                    .Visible = True
                                    .ForeColor.RGB = RGB(0, 0, 0)
                                    .Weight = 1
                                End With
                                With .Borders(ppBorderRight)
                                    .Visible = False
                                    .ForeColor.RGB = RGB(0, 0, 0)
                                    .Weight = 1
                                    .Transparency = 1
                                End With
                            End With
                        ElseIf iRow > 1 And iRow < (oTable.Rows.Count - 1) Then
                            'Format second to second-last rows
                            .Shape.TextFrame.TextRange.Font.Bold = False
                            ' check if odd number
                            If Not iRow Mod 2 <> 0 Then
                                .Shape.Fill.ForeColor.RGB = RGB(235, 235, 235)
                            Else
                                .Shape.Fill.ForeColor.RGB = RGB(255, 255, 255)
                            End If
                            With oTable.Cell(iRow, iCol)
                                With .Borders(ppBorderLeft) 'Left
                                    .Visible = msoFalse
                                    .ForeColor.RGB = RGB(255, 255, 255)
                                    .Weight = 1
                                    .Transparency = 1
                                End With
                                With .Borders(ppBorderBottom) 'Bottom
                                    .Visible = msoTrue
                                    .ForeColor.RGB = RGB(255, 255, 255)
                                    .Weight = 1
                                    .Transparency = 1
                                End With
                                With .Borders(ppBorderRight) 'Right
                                    .Visible = msoFalse
                                    .ForeColor.RGB = RGB(255, 255, 255)
                                    .Weight = 1
                                    .Transparency = 1
                                End With
                            End With
                        ElseIf iRow = (oTable.Rows.Count - 1) Then
                            'Apply different formatting to second-last row
                            .Shape.TextFrame.TextRange.Font.Bold = False
                            If Not iRow Mod 2 <> 0 Then
                                .Shape.Fill.ForeColor.RGB = RGB(235, 235, 235)
                            Else
                                .Shape.Fill.ForeColor.RGB = RGB(255, 255, 255)
                            End If
                            With oTable.Cell(iRow, iCol)
                                With .Borders(ppBorderLeft) 'Left
                                    .Visible = msoFalse
                                    .ForeColor.RGB = RGB(255, 255, 255)
                                    .Weight = 1
                                    .Transparency = 1
                                End With
                                With .Borders(ppBorderBottom) 'Bottom
                                    .Visible = msoTrue
                                    .ForeColor.RGB = RGB(0, 0, 0)
                                    .Weight = 1
                                    .Transparency = 0
                                End With
                                With .Borders(ppBorderRight) 'Right
                                    .Visible = msoFalse
                                    .ForeColor.RGB = RGB(255, 255, 255)
                                    .Weight = 1
                                    .Transparency = 1
                                End With
                            End With
                        Else
                            'Format last row
                            .Shape.Fill.ForeColor.RGB = RGB(255, 255, 255)
                            With oTable.Cell(iRow, iCol)
                                With .Borders(ppBorderTop)
                                    .Visible = True
                                    .ForeColor.RGB = RGB(0, 0, 0)
                                    .Weight = 1
                                End With
                                With .Borders(ppBorderBottom)
                                    .Visible = True
                                    .ForeColor.RGB = RGB(0, 0, 0)
                                    .Weight = 1
                                End With
                            End With
                            oTable.Cell(iRow, iCol).Shape.TextFrame.TextRange.Font.Bold = True
                        End If
                    End With
                Next iCol
            Next iRow
        End If
    End Sub