CODEWITHSUNDEEP
vbapowerpoint
Miguel de las Nieves
Miguel de las Nieves

Reputation: 117

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

Upvotes: 0

Views: 396

Answers (1)

John Korchok
John Korchok

Reputation: 4913

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

Upvotes: 1

Related Questions