Как скопировать строки в PowerPoint 2003 с VBA?

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