如何使用 VBA 在 PowerPoint 2003 中复制行？

Question

我需要在 PowerPoint 2003 中复制行（只是为了重新使用它们的格式）。尝试这样做：

Dim oPPTRow As PowerPoint.Row

Set oPPTRow = oPPTFile.Slides(SlideNum).Shapes(1).Table.Rows(2)
oPPTFile.Slides(SlideNum).Shapes(1).Table.Rows.Add (-1)
oPPTFile.Slides(SlideNum).Shapes(1).Table.Rows(oPPTTable.Rows.Count) = oPPTRow

但没有成功。还有其他方法可以达到同样的效果吗？

Answer 1

Rows.Add 方法允许您在所需的任何行之前插入新行。新插入的行将采用您之前插入的行的格式。试试这个（一定要先选择一个表格形状）：

Sub AddNewRow()
    Dim oTbl As Table
    Dim oSh As Shape

    Set oSh = ActiveWindow.Selection.ShapeRange(1)
    Set oTbl = oSh.Table

    With oTbl
        .Rows.Add (2)
    End With
End Sub

将 -1 作为参数传递给 .Add 强制 PPT 在表格末尾添加行；新单元格的格式将与其上面的单元格相同（即，之前位于底行的行中的单元格）。

如果您需要从其他行获取格式，我认为您可能需要执行以下操作：

Sub AddNewRow()
    Dim oTbl As Table
    Dim oSh As Shape
    Dim x As Long
    Dim lNewRow As Long

    Set oSh = ActiveWindow.Selection.ShapeRange(1)
    Set oTbl = oSh.Table

    With oTbl
        .Rows.Add (-1)
        lNewRow = .Rows.Count
        ' format the new row to match the cells in row two
        With .Rows(lNewRow)
            ' step across the row cell by cell
            For x = 1 To oTbl.Columns.Count

                ' pick up row two formatting
                oTbl.Cell(2, x).Shape.PickUp
                ' apply it to new row's cell x
                .Cells(x).Shape.Apply

                ' do the same for cell's text formatting
                oTbl.Cell(2, x).Shape.TextFrame.TextRange.Font.Name = oTbl.Cell(2, x).Shape.TextFrame.TextRange.Font.Name
                ' Use above pattern to pick up/apply font bold, ital, size, color etc as needed
            Next
        End With
    End With
End Sub