Comment copier des lignes dans PowerPoint 2003 avec VBA?

Question

Je dois copier des lignes dans PowerPoint 2003 (juste pour réutiliser leur mise en forme). J'ai essayé de le faire:

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 

Mais cela ne fonctionne pas. Y a-t-il un autre moyen d'atteindre la même chose?

Answer 1

La méthode Rows.Add vous permet d'insérer une nouvelle ligne avant toute ligne de votre choix. La ligne nouvellement insérée prendra le formatage de la ligne dans laquelle vous l'avez inséré. Essayer ce (être sûr de choisir une forme de tabel premier):

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 

Passe -1 en tant que paramètre de force .Add PPT pour ajouter la ligne à la fin de la table; les nouvelles cellules seront toutes formatées de la même manière que les cellules au-dessus d'elles (c'est-à-dire, les cellules de la rangée qui était précédemment la rangée du bas).

Si vous devez ramasser le formatage d'une autre ligne, je pense que vous devrez peut-être faire quelque chose comme:

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