Powerpoint table 格式化;最后一行边框没有样式
Powerpoint table formatting; last row borders not styled
我正在尝试将选定的 table 格式设置为第一行无色,带底边框,浅灰色行,最后一行带上下边框。
除了最后一行的顶部和底部边框样式不正确外,一切似乎都正常。
你能帮我解决这个问题吗?
提前致谢!
代码如下:
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
执行此操作的最佳方法是编辑演示文稿 XML 以创建自定义 table 样式。然后你会得到一个 table ,你可以在其中使用程序界面来切换 header 和总行数以及打开和关闭条带,就像真正的 PowerPoint table.
编辑 XML 与编辑 HTML 非常相似。以下是我关于如何执行此操作的文章:OOXML Hacking: Custom Table Styles OOXML Hacking: Table Styles Complete OOXML Hacking: Default Table Text
但是既然你已经开始用 VBA 做这件事了,让我们完成这个任务吧。您的代码有很多错误,但 tables 的主要问题是底行的上边框不仅仅属于底行。它也是倒数第二行的底部边框。
此代码设置倒数第二行的底部边框和最后一行的顶部边框。它在这里工作:
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
我正在尝试将选定的 table 格式设置为第一行无色,带底边框,浅灰色行,最后一行带上下边框。
除了最后一行的顶部和底部边框样式不正确外,一切似乎都正常。
你能帮我解决这个问题吗?
提前致谢!
代码如下:
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
执行此操作的最佳方法是编辑演示文稿 XML 以创建自定义 table 样式。然后你会得到一个 table ,你可以在其中使用程序界面来切换 header 和总行数以及打开和关闭条带,就像真正的 PowerPoint table.
编辑 XML 与编辑 HTML 非常相似。以下是我关于如何执行此操作的文章:OOXML Hacking: Custom Table Styles OOXML Hacking: Table Styles Complete OOXML Hacking: Default Table Text
但是既然你已经开始用 VBA 做这件事了,让我们完成这个任务吧。您的代码有很多错误,但 tables 的主要问题是底行的上边框不仅仅属于底行。它也是倒数第二行的底部边框。
此代码设置倒数第二行的底部边框和最后一行的顶部边框。它在这里工作:
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