Macro : rajouter des lignes à un tableau généré dans powerpoint

[fid]

bonjour le forum !
j'avance dans mon application, mais bon je coince souvent sur la formulation
voici mon problème :
dans la macro suivante je veux :

si la condition "cellule G = 0" ne pas créer de slide dans PPT
sinon dupliquer le slide(1) et remplir le tableau avec les données de la "feuil1"
jusque là pas de problème tout s'exécute bien​

mais je veux également :

si la condition "cellule B = cellule G", copier les lignes 4 et 5 du slide, les ajouter après la dernière ligne (soit la 5 au départ)
et les remplir avec les données de la "feuil1"
et ce jusqu'à ce que "cellule B <> cellule G​

j'avoue que je n'arrive pas à trouver la meilleure syntaxe pour traduire cela dans la macro

Sub BoucleTest2Conditions()
Dim objPPT As Object
Dim objPres As Object
Dim objSld As Object
Dim objShp As Object
Dim shp As Shape

With Sheets("Feuil1")
    Tablo = Range("A2:Z" & Range("A65000").End(xlUp).Row).Value
End With

Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True

Set objPres = objPPT.Presentations.Open(ThisWorkbook.Path & "\note2.pptm")
objPres.SaveAs ThisWorkbook.Path & "\test.ppt"



For i = 1 To UBound(Tablo)
    'si la cellule G est égale 0, alors ne fait rien,
        
        If Tablo(i, 7) = 0 Then
        x = x + 1
       'sinon
       Else
    'duplique le slide 1
    Set objSld = objPres.Slides(1).Duplicate
    'remplit le tableau du slide avec les données
    For Each objShp In objSld.Shapes
        If objShp.HasTable Then
            With objShp.Table
                x = x + 1
                .Cell(1, 1).Shape.TextFrame.TextRange.Text = Tablo(x, 2) 'Tableau
                .Cell(4, 1).Shape.TextFrame.TextRange.Text = Tablo(x, 3) 'Qte
                .Cell(4, 2).Shape.TextFrame.TextRange.Text = Tablo(x, 4) 'Description1
                .Cell(5, 2).Shape.TextFrame.TextRange.Text = Tablo(x, 5) 'Description2
            '=============================================================================
            'nouvelle condition :
                'si la cellule B = G, alors
            If Tablo(i, 2) = Tablo(i, 7) Then
            'copie la ligne 2 et 3 du tableau du slide et ajoute les à la suite
            '.Row (4) & Row(5).Copy
            'et remplit les avec les données
                .Cell(4, 1).Shape.TextFrame.TextRange.Text = Tablo(x, 3) 'Qte
                .Cell(4, 2).Shape.TextFrame.TextRange.Text = Tablo(x, 4) 'Description1
                .Cell(5, 2).Shape.TextFrame.TextRange.Text = Tablo(x, 5) 'Description2
            'et autant de fois qu'il y a de lignes où cell B = G
             End If
            End With
        End If
    Next
    End If
Next

objPres.Slides(1).Delete
objPres.Save
objPres.Close

End Sub

Merci de m'éclairer sur ce que je peux faire pour que cela tourne correctement !

 

[PMO2]

Re : Macro : rajouter des lignes à un tableau généré dans powerpoint

Bonjour,

Peut-être une piste avec

Sub BoucleTest2Conditions()
Dim objPPT As Object
Dim objPres As Object
Dim objSld As Object
Dim objShp As Object
Dim shp As Shape
Dim Tablo As Variant
Dim i As Long
Dim x As Long
With Sheets("Feuil1")
  Tablo = Range("A2:Z" & Range("A65000").End(xlUp).Row)
End With
Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True
Set objPres = objPPT.Presentations.Open(ThisWorkbook.Path & "\note2.ppt")
objPres.SaveAs ThisWorkbook.Path & "\test.ppt"
For i = 1 To UBound(Tablo)
    'si la cellule G est égale 0, alors ne fait rien,
  If Tablo(i, 7) = 0 Then
    x = x + 1
  Else
    'duplique le slide 1
    Set objSld = objPres.Slides(1).Duplicate
    'remplit le tableau du slide avec les données
    For Each objShp In objSld.Shapes
      If objShp.HasTable Then
        With objShp.Table
          x = x + 1
          If Tablo(i, 2) <> Tablo(i, 7) Then
            .Cell(1, 1).Shape.TextFrame.TextRange.Text = Tablo(x, 2) 'Tableau
            .Cell(4, 1).Shape.TextFrame.TextRange.Text = Tablo(x, 3) 'Qte
            .Cell(4, 2).Shape.TextFrame.TextRange.Text = Tablo(x, 4) 'Description1
            .Cell(5, 2).Shape.TextFrame.TextRange.Text = Tablo(x, 5) 'Description2
            '=============================================================================
          'nouvelle condition :
            'si la cellule B = G, alors
          Else
            '### ajoute 2 lignes ###
            .Rows.Add (-1)
            .Rows.Add (-1)
            'Je n'ai pas compris ce qu'il faut faire pour la suite
            '#######################

          'et remplit les avec les données
            .Cell(1, 1).Shape.TextFrame.TextRange.Text = Tablo(x, 2) 'Tableau
            .Cell(4, 1).Shape.TextFrame.TextRange.Text = Tablo(x, 3) 'Qte
            .Cell(4, 2).Shape.TextFrame.TextRange.Text = Tablo(x, 4) 'Description1
            .Cell(5, 2).Shape.TextFrame.TextRange.Text = Tablo(x, 5) 'Description2
          'et autant de fois qu'il y a de lignes où cell B = G
          End If
        End With
      End If
    Next objShp
  End If
Next i

objPres.Slides(1).Delete
objPres.Save
objPres.Close

End Sub

Cordialement.

PMO
Patrick Morange

 

[fid]

Re : Macro : rajouter des lignes à un tableau généré dans powerpoint

Bonjour Patrick et merci

voici ce que cela donne :
===================
Sub BoucleTest2Conditions()
Dim objPPT As Object
Dim objPres As Object
Dim objSld As Object
Dim objShp As Object
Dim shp As Shape

With Sheets("Feuil1")
Tablo = Range("A2:Z" & Range("A65000").End(xlUp).Row).Value
End With

Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True

Set objPres = objPPT.Presentations.Open(ThisWorkbook.Path & "\note2.pptm")
objPres.SaveAs ThisWorkbook.Path & "\test.ppt"



For i = 1 To UBound(Tablo)
'si la cellule G est égale 0, alors ne fait rien,

If Tablo(i, 7) = 0 Then
x = x + 1
'sinon
Else
'duplique le slide 1
Set objSld = objPres.Slides(1).Duplicate
'remplit le tableau du slide avec les données
For Each objShp In objSld.Shapes
If objShp.HasTable Then
With objShp.Table
x = x + 1
.Cell(1, 1).Shape.TextFrame.TextRange.Text = Tablo(x, 2) 'Tableau
.Cell(4, 1).Shape.TextFrame.TextRange.Text = Tablo(x, 3) 'Qte
.Cell(4, 2).Shape.TextFrame.TextRange.Text = Tablo(x, 4) 'Description1
.Cell(5, 2).Shape.TextFrame.TextRange.Text = Tablo(x, 5) 'Description2
'=============================================================================
'nouvelle condition :
'si la cellule B3 = B2, alors Ajoute autant de lignes que la condition est vraie
'par exemple si B3 = B2, B4=B3, B5=B4 alors insère 3 fois les 2 dernières lignes du tableau du slide
If Tablo(i + 1, 2) = Tablo(i, 2) Then
.Rows.Add (-1)
.Rows.Add (-1)
Et remplit les cellules correspondantes avec les valeurs
=====
je joins le fichier mis à jour avec en feuille 2, le modèle de tableau que cela génère dans PPT
je pense qu'à la place du If Tablo(i + 1, 2) = Tablo(i, 2) Then il faudrait mettre un For Each (Tablo(i + 1, 2) = Tablo(i, 2)) in (Colonne B) mais bon je vois mal comment le syntaxer

d'avance merci pour ton aide

 

[PMO2]

Re : Macro : rajouter des lignes à un tableau généré dans powerpoint

Bonjour,

J'ai fait une autre approche. C'est dans Excel que l'on crée, à partir d'un modèle (la feuille Export PPT dans l'exemple joint), le tableau qui sera exporté dans PowerPoint.

Reportez-vous à la pièce jointe.

Cordialement.

PMO
Patrick Morange

 

[fid]

Re : Macro : rajouter des lignes à un tableau généré dans powerpoint

bonjour Patrick,

merci pour ton fichier, malheureusement il y a un souci car lors du lancement j'ai un message d'erreur au niveau de :
"PptPres.SaveAs ThisWorkbook.Path & "\test.ppt"

voici le message d'erreur :
Shapes.Paste invalid request clipboard is empty or contains data which may not be pastered here

effectivement quand on regarde le tableau de la feuille EXPORT PPT, il est vide, donc je pense que le problème vient de là
par contre j'ai un peu de mal à voir dans la macro où se situe le problème ?

merci pour votre aide
cordialement

 

[PMO2]

Re : Macro : rajouter des lignes à un tableau généré dans powerpoint

Bonjour,

J'ai développé sous Excel 2003 et, si vous êtes sur version Excel 2007 ou plus récente, je pense qu'il faut changer l'instruction

PptPres.SaveAs ThisWorkbook.Path & "\test.ppt"

par

PptPres.SaveAs ThisWorkbook.Path & "\test.pptm"

Le suffixe ppt ayant été remplacé par le suffixe pptm

Est-ce mieux ?

Cordialement.

PMO
Patrick Morange

 

[fid]

Re : Macro : rajouter des lignes à un tableau généré dans powerpoint

bonjour Patrick,

je viens de tester mais j'ai le même message la ligne de code en dessous :
"End If
Set PptSlide = PptPres.Slides.Add(Index:=1, Layout:=12) '12=ppLayoutBlank
PptSlide.Shapes.Paste"

par contre j'ai obtenu une réponse à ma question initiale, et je pense que le code ci-dessous peut vous intéresser
je mets directement le fichier pour plus de simplicité le fichier excel qui va bien et l'image du slide qui doit se composer au fur et à mesure
Reste encore une question concernant la copie des lignes 4 et 5 qui ont une structure différente (voir les explications dans le code)

Par contre je reste intéressée par la solution à votre propre code
encore merci de votre aide