générer 2 lignes structures différentes en VBA

Version imprimable

Bonjour à tous,

je reprends le code que Qwazerty m'a fourni et qui fonctionne super bien pour générer des slides dans PPT à partir d'un fichier Excel
et générer autant de lignes dans le tableau PPT que de lignes de données dans Excel
====
voici la structure de mon tableau PPT :
les 3 premières lignes = 1 seule cellule
la 4ème = 2 cellules
la 5ème = 3 cellules
lorsque j'ajoute des lignes, elles doivent être au format de la 4ème et de la 5ème
comment expliquer cela en VBA pour que le code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
For Each objShp In objSld.Shapes
        If objShp.HasTable Then
            With objShp.Table
                .Cell(1, 1).Shape.TextFrame.TextRange.Text = Tablo(i, 2) 'Tableau
                .Cell(4, 1).Shape.TextFrame.TextRange.Text = Tablo(i, 6) 'Qte
                .Cell(4, 2).Shape.TextFrame.TextRange.Text = Tablo(i, 7) 'Description1
                .Cell(5, 2).Shape.TextFrame.TextRange.Text = Tablo(i, 11) 'Description2
                .Cell(5, 2).Shape.TextFrame.TextRange.Text = Tablo(i, 12) 'Description2
                '=============================================================================
                'nouvelle condition :
                'si la cellule B = G, alors
                x = 0
                Do
                    
                    'copie la ligne 4 et 5 du tableau du slide et ajoute les à la suite
                    If x > 0 Then
                        .Rows.Add
                        .Rows.Add                    End If
                    'et remplit les avec les données
                    .Cell(4 + (2 * x), 1).Shape.TextFrame.TextRange.Text = Tablo(i, 6) 'Qte
                    .Cell(4 + (2 * x), 2).Shape.TextFrame.TextRange.Text = Tablo(i, 7) 'Description1
                    .Cell(5 + (2 * x), 2).Shape.TextFrame.TextRange.Text = Tablo(i, 11) 'Description2
                    .Cell(5 + (2 * x), 3).Shape.TextFrame.TextRange.Text = Tablo(i, 12) 'Description2
                    'et autant de fois qu'il y a de lignes où cell B = G
                    i = i + 1
                    x = x + 1
                    If i > UBound(Tablo) Then Exit Do
                Loop While Tablo(i, 2) = Tablo(i - 1, 2)
            End With
        End If
    Next
Next

que faut il mettre à cet endroit pour faire comprendre qu'il faut copier la ligne 4 et 5 (avec leur structure)
If x > 0 Then
.Rows.Add
.Rows.Add
End If
d'avance merci pour votre aide

Salut
Pourrais tu ajouter un pps avec la structure que tu souhaites, par ce que le fichier que tu avais fourni dans l'autre discussion n'a pas la structure que tu annonces ici, la 5eme ligne pour moi n'a que 2 colonnes.
Si c'est une évolution du besoin, tu peux faire comme cela.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Sub BoucleTest2Conditions()
'Active dans les references (menu option) la ligne "Microsoft PowerPoint x.x Object Library",
'si tu veux, tu pourras par la suite remettre les Objects pour ne pas avoir a activer cette reference sur les autre postes
'Mais pour developper c'est plus simple
Dim objPPT As PowerPoint.Application  'Object
Dim objPres As PowerPoint.Presentation ' Object
Dim objSld As PowerPoint.SlideRange ' Object
Dim objShp As PowerPoint.Shape ' Object
Dim shp As PowerPoint.Shape
Dim Tablo As Variant
Dim x As Integer, i As Integer, y As Integer
 
 
With Sheets("Feuil1") 'Il faut presiser le "." dans la suite du code pour y faire reference
    Tablo = .Range("A2:Z" & .Cells(Rows.Count, "A").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 & "\test3.ppt"
 
 
 
For i = 1 To UBound(Tablo)
    'duplique le slide 1
    Set objSld = objPres.Slides(1).Duplicate
    'On le place au dessous de tout
    objSld.moveto objPres.Slides.Count
    'remplit le tableau du slide avec les données
    For Each objShp In objSld.Shapes
        If objShp.HasTable Then
            With objShp.Table
                .Cell(1, 1).Shape.TextFrame.TextRange.Text = Tablo(i, 2) 'Tableau
                x = 0
                Do
                    'On rajoute 2 ligne pour une nouvelle saisi, s'il y a plus d'un article
                    If x > 0 Then
                        With .Rows.Add
                            'Si la ligne contient 3 colonne, on en supprime une
                            If .Cells.Count > 2 Then .Cells(3).Merge .Cells(2)
                        End With
                        With .Rows.Add
                            'ici la nouvelle ligne aura 3 colonnes, puisque powerpoint reproduit la derniere ligne du tableau lors d'un ajout
                            'On supprime donc une colonne
                            .Cells.Item(2).Split 1, 2
                        End With
                    End If
                    'On saisi les differentes valeurs
                    .Cell(4 + (2 * x), 1).Shape.TextFrame.TextRange.Text = Tablo(i, 3) 'Qte
                    .Cell(4 + (2 * x), 2).Shape.TextFrame.TextRange.Text = Tablo(i, 4) 'Description1
                    .Cell(5 + (2 * x), 2).Shape.TextFrame.TextRange.Text = Tablo(i, 5) 'Description2
                    'et autant de fois qu'il y a de lignes où cell B = G
                    i = i + 1
                    x = x + 1
                    If i > UBound(Tablo) Then Exit Do
                Loop While Tablo(i, 2) = Tablo(i - 1, 2)
            End With
        End If
    Next
Next

++
Qwaz

25/01/2011, 11h14
fidecourt

1 pièce(s) jointe(s)
bonjour Qwazerty,

effectivement j'affine au fur et à mesure...
je joins un exemple complet PPT + fichier excel

le PPT final devra comprendre pour un enregistrement de tableau :

2 SLIDES qui se suivent :
- 1 avec les données
- 1 avec l'image
pour 1 TABLEAU
je peux avoir :
1 article avec 1 qté et 1 description
mais aussi pour un même article
- Qté1 et Description1 (toujours quelque soit le cas de figure)
- Qté 2 et description2
- pas de qté, mais une description2 tout de même
ensuite je voudrais centrer ce tableau dans la page afin de garder une jolie présentation
quant au titre du tableau, je pense le mettre dans un tableau à part au dessus afin de garder une présentation cohérente dans tous les cas de figures des différents TABLEAUX

dans l'exemple joint, je mets :
le PPT qui sert à la fusion (2 premiers slides)
et l'exemple pour le TABLEAU VERT (les 2 autres slides) pour mieux voir le besoin

il faut que je rajoute des SI
car
Si 'col E et F' sont vides, alors création d'une ligne avec 2 cellules au dessous
sinon création d'une ligne avec 3 cellules

bref, encore pas mal de code à résoudre
d'avance merci de ton aide
25/01/2011, 18h13
Qwazerty

Salut
As tu testé le code que je t'avais donné?
La structure du pps semble assez complexe, il serait bien de nous mettre un fichier pps, avec la structure que tu souhaites.
N'hésite pas a faire plusieurs pages contenant les différents cas que tu cites.
++
Qwaz
25/01/2011, 18h42
fidecourt

1 pièce(s) jointe(s)

Bonsoir,

oui j'ai testé le code, mais cela coince et met un message d'erreur dès que la macro essaie de fusionner les cellules, j'ai laissé de côté pour le moment car je poursuis mon dev par ailleurs en même temps
j'espère qu'à la fin cela fera un bon modèle pour mettre à dispo de tous, mais cela n'est pas fini....
je te joins un modèle complet que j'ai renseigné, ce matin je n'ai pas joint le bon a priori par rapport à mes explications
est ce que cela te semble plus clair ?
25/01/2011, 19h31
Qwazerty

Salut
Désolé, mais je ne comprend pas la logique de mise en page que tu souhaites, les données dans le tableau et celles dans le PPS ne semblent pas correspondre.
Peux tu refaire un exemple avec juste un tableau, données excel + pps
+
Qwaz
26/01/2011, 10h11
fidecourt

1 pièce(s) jointe(s)

Bonjour,

voici le fichier Excel avec dans la feuille la représentation PPT
est-ce cela que tu souhaites pour mieux voir ?
A+

Salut
Bon voila, cette fois, ça devrait etre ok.
Tu n'as plus besoin du fichier temporaire *.pptm, la macro cré le fihcier et l'organise comme tu le souhaites.
Voila le code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Option Explicit 'T'oblige a declarer toutes les variables que tu utilises
'Forum DEVELOPPEZ.COM - Auteur : Qwazerty
Sub BoucleTest2Conditions()
'Active dans les references (menu option) la ligne "Microsoft PowerPoint x.x Object Library"
 
Dim objPPT As PowerPoint.Application
Dim objPres As PowerPoint.Presentation
Dim objSld As PowerPoint.Slide
Dim ObjShTable As PowerPoint.Shape
Dim Tablo As Variant
Dim x As Integer, i As Integer
Dim CustLayout As PowerPoint.CustomLayout
Dim TheRow As PowerPoint.Row
Dim NomTableau As String
Dim NewTop As Integer
Dim TheShTab As PowerPoint.Shape
Dim TmpTop As Integer
 
 
With Sheets("Feuil1") 'Il faut presiser le "." dans la suite du code pour y faire reference
    Tablo = .Range("A2:Z" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
End With
 
Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True
 
'Set objPres = objPPT.Presentations.Open(ThisWorkbook.Path & "\note2.pptm")
 
Set objPres = objPPT.Presentations.Add
objPres.SaveAs ThisWorkbook.Path & "\test3.ppt"
 
 
Set CustLayout = objPres.SlideMaster.CustomLayouts.Add(1)
'Si tu veux changer les couleur sur ous tes Slide, il faut modifier CustLayout
'Ca affectera directement la présentation des slides
For i = 1 To UBound(Tablo)
    'On regarde si on doit créer un nouveau Slide ou completer l'existant
    If NomTableau <> Tablo(i, 2) Then
        'On garde en memoire le nom du tableau
        NomTableau = Tablo(i, 2)
 
        'On ajoute un nouveau Slide
        Set objSld = objPres.Slides.AddSlide(objPres.Slides.Count + 1, CustLayout)
 
        'On renseigne le titre du slide
        objSld.Shapes.Title.TextFrame.TextRange.Text = Tablo(i, 2)
    End If
 
    'On crée le tableau qui contiendra les données avec 2 ligne 3 colonnes ou 1 ligne 3 colonnes
    If Tablo(i, 6) <> "" Then
        Set ObjShTable = objSld.Shapes.AddTable(2, 3)
    Else 'Si pas de sous element precisé
        Set ObjShTable = objSld.Shapes.AddTable(1, 3)
    End If
 
    'On regarde si des objet tableau existe et on le rajoute a la suite du plus bas
    NewTop = ObjShTable.Top
    For Each TheShTab In objSld.Shapes
        If TheShTab.HasTable And (TheShTab.Name <> ObjShTable.Name) Then
            TmpTop = TheShTab.Top + TheShTab.Height
            If NewTop < TmpTop Then NewTop = TmpTop + 3
        End If
    Next
    ObjShTable.Top = NewTop
 
    'On dimensionne la taille des colonnes (a toi de voir)
    With ObjShTable.Table
        .Columns(1).Width = 40
        .Columns(2).Width = 40
        .Columns(3).Width = 480
 
        'On Rajoute les données article
        'On fusionne les 2 dernieres cellules de a ligne 1
        .Cell(1, 2).Merge .Cell(1, 3)
        'On place l'item principal
        .Cell(1, 1).Shape.TextFrame.TextRange.Text = Tablo(i, 3) 'Qte
        .Cell(1, 2).Shape.TextFrame.TextRange.Text = Tablo(i, 4) 'Description
        'On place le sous-essemble uniquement s'il existe
        If Tablo(i, 6) <> "" Then
            .Cell(2, 2).Shape.TextFrame.TextRange.Text = Tablo(i, 5) 'Qte
            .Cell(2, 3).Shape.TextFrame.TextRange.Text = Tablo(i, 6) 'Description
        End If
    End With
Next
 
objPres.Save
objPres.Close
 
End Sub

++
Qwaz

1 pièce(s) jointe(s)

bonjour Qwazerty

ça fonctionne super !
j'ai rajouté le code nécessaire pour générer le slide contenant la photo correspondant à mon tableau

par contre je ne vois pas comment personnaliser le LAYOUT ?

"Set CustLayout = objPres.SlideMaster.CustomLayouts.Add(1)"

comment savoir quel code indiquer ?

car celui qui sera utilisé est personnalisé
avec un thème, un logo, un encadrement extérieur avec bord arrondi et couleur pour les tableaux, et pas d'encadrement lorsque j'insère une image

où trouver ce code puisque dans PPT, je ne peux rien voir du code ?

je veux pour chaque tableau de données, le centrer en hauteur dans la page
bref, je ne sais comment faire
est il possible de mettre le chemin du modèle du slide1 pour les données et ainsi ne pas avoir à personnaliser dans le code ces propriétés
et idem pour le slide2 ?

chemin du modèle créé : c:\DEVIS\PPT\DEVIS-PPT.potx

ce serait plus simple mais comment expliquer tout cela en VBA ?

voici le code modifié avec l'insertion image en slide 2 et la personnalisation de mon fichier réel

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
Option Explicit 'T'oblige a declarer toutes les variables que tu utilises
'Forum DEVELOPPEZ.COM - Auteur : Qwazerty
Sub POWERPOINT()
'Active dans les references (menu option) la ligne "Microsoft PowerPoint x.x Object Library"
 
Dim objPPT As Object 'POWERPOINT.Application
Dim objPres As Object 'POWERPOINT.Presentation
Dim objSld As Object 'POWERPOINT.Slide
Dim ObjShTable As Object 'POWERPOINT.Shape
Dim Tablo As Variant
Dim x As Integer, i As Integer
Dim CustLayout As Object 'POWERPOINT.CustomLayout
Dim TheRow As Variant 'POWERPOINT.Row
Dim NomTableau As String
Dim NewTop As Integer
Dim TheShTab As Object 'POWERPOINT.Shape
Dim TmpTop As Integer
Dim objSldImg As Object
Dim objSldImgTable As Object
Dim ObjShImgTable As Object
 
With Sheets("description-prod") 'Il faut presiser le "." dans la suite du code pour y faire reference
    Tablo = .Range("A2:Z" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
End With
 
Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True
 
Set objPres = objPPT.Presentations.Add
objPres.SaveAs ThisWorkbook.Path & "\test3.ppt"
 
Set CustLayout = objPres.SlideMaster.CustomLayouts.Add(1)
'Si tu veux changer les couleur sur ous tes Slide, il faut modifier CustLayout
'Ca affectera directement la présentation des slides
For i = 1 To UBound(Tablo)
    'On regarde si on doit créer un nouveau Slide ou completer l'existant
    If NomTableau <> Tablo(i, 2) Then
        'On garde en memoire le nom du tableau
        NomTableau = Tablo(i, 2)
 
        'On ajoute un nouveau Slide pour insérer les données
        Set objSld = objPres.Slides.AddSlide(objPres.Slides.Count + 1, CustLayout)
 
        'On renseigne le titre du slide
        objSld.Shapes.Title.TextFrame.TextRange.Text = Tablo(i, 2)
 
        'On ajoute un nouveau slide pour insérer l'image
        Set objSldImg = objPres.Slides.AddSlide(objPres.Slides.Count + 1, CustLayout)
 
        'on crée un tableau d'une seule cellule pour recevoir l'image
        Set ObjShImgTable = objSldImg.Shapes.AddTable(1, 1)
        'on dimensionne la cellule pour l'image
        With ObjShImgTable.Table
        .Columns(1).Width = 500
        .Rows(1).Height = 350
        .Cell(1, 1).Shape.Fill.UserPicture (Tablo(i, 19)) 'insertion de l'image correspondante
         End With
 
    End If
 
    'On crée le tableau qui contiendra les données avec 2 ligne 3 colonnes ou 1 ligne 3 colonnes
    If Tablo(i, 12) <> "" Then
        Set ObjShTable = objSld.Shapes.AddTable(2, 3)
    Else 'Si pas de sous element precisé
        Set ObjShTable = objSld.Shapes.AddTable(1, 3)
    End If
 
    'On regarde si des objet tableau existe et on le rajoute a la suite du plus bas
    NewTop = ObjShTable.Top
    For Each TheShTab In objSld.Shapes
        If TheShTab.HasTable And (TheShTab.Name <> ObjShTable.Name) Then
            TmpTop = TheShTab.Top + TheShTab.Height
            If NewTop < TmpTop Then NewTop = TmpTop + 3
        End If
    Next
    ObjShTable.Top = NewTop
 
    'On dimensionne la taille des colonnes (a toi de voir)
    With ObjShTable.Table
        .Columns(1).Width = 40
        .Columns(2).Width = 40
        .Columns(3).Width = 480
 
 
        'On Rajoute les données article
        'On fusionne les 2 dernieres cellules de a ligne 1
        .Cell(1, 2).Merge .Cell(1, 3)
        'On place l'item principal
        .Cell(1, 1).Shape.TextFrame.TextRange.Text = Tablo(i, 6) 'Qte
        .Cell(1, 2).Shape.TextFrame.TextRange.Text = Tablo(i, 7) 'Description
        'On place le sous-ensemble uniquement s'il existe
        If Tablo(i, 12) <> "" Then
            .Cell(2, 2).Shape.TextFrame.TextRange.Text = Tablo(i, 11) 'Qte
            .Cell(2, 3).Shape.TextFrame.TextRange.Text = Tablo(i, 12) 'Description
        End If
    End With
Next
 
 
objPres.save
objPres.Close
 
End Sub

je joins le fichier PPT des 2 modèles à utiliser

merci pour ton aide

27/01/2011, 18h15
Qwazerty

Salut

Alors pour le Layout, faut chercher dans les propriétés, je sais c'est pas facile, tu as possibilité d'utiliser la touche F2, elle ouvre l'explorateur d'objet, c'est pratique, en haut tu tape le nom de l'objet, tu sélectionnes celui qui correspond a ton besoin dans la 1ere liste et tu obtiens la liste de ses propriétés et méthodes.
Le Layout réagis comme l'objet Slide m'a t il semblé.

Pour avoir une mise en page différente entre tableau et image, il faut créer 2 Layout. Un LayoutTableau et un LayoutImage, les personnaliser et les utiliser respectivement lors de l'ajout d'un Slide Tableau et Slide Image.

Pour ce qui est du .Potx, je ne sais pas, il faut voir, au pire il serait peut être possible de juste récupérer les layout des type Slide Tableau et Image et faire comme expliqué précédemment.

Pour le centrage, il suffit de modifier la propriété Width des colonnes, c'est commenté dans le code (a adapter)

++
Qwaz
27/01/2011, 18h23
fidecourt

merci pour ta réponse,

je vais regarder tout cela,
j'ai mis également la question sur le forum de PPT du site pour voir si un expert PPT a une solution simple
A voir en attendant je poursuis
mais encore merci pour ton aide, car cela fonctionne déjà super bien
bon j'ai encore à faire.... mais bon je vais y arriver !:D
27/01/2011, 18h35
Qwazerty

Salut
Attention au nom de tes Sub, la nommé PowerPoint est une très mauvaise idée, je pense d'ailleurs comprendre que c'est pour ça que tu as remis les Objects au lieu de déclarer PowerPoint.Layout par exemple, par ce que ça planté, normal, quand tu notes "powerpoint" vba essai d'utiliser ta Sub du même nom... mais celle ci n'a aucune propriété ou méthode.
++
Qwaz
28/01/2011, 09h48
fidecourt

bonjour Qwazerty,

je vais renommer la macro, mais cela n'a rien à voir avec le nom de l'objet, car j'ai la même erreur quelque soit le nom :

"erreur de compilation" type défini par l'utilisateur non défini"

donc j'ai remis As Object qui fonctionne parfaitement
peux-tu me dire quel est l'avantage de syntaxer comme tu l'as fait plutôt que de mettre As object ?

je vais ouvrir une nouvelle discussion sur le thème du slide depuis excel, puisque j'ai clos celle-ci, car maintenant j'avance à grand pas mais bien entendu, je me confronte à de nouveaux soucis !!!

A bientôt
28/01/2011, 10h19
Qwazerty

Salut
Il y a a mon sens un inconvénient a syntaxer en utilisant les références, c'est qu'il faut que le poste ou tu déploies ta macro est cette référence en boutique, mais dans le cas de PowerPoint (outre le soucis de version) il y a de forte chance que celle ci soit présente.

Pour ce qui est de l'avantage, c'est sans conteste l'auto-complétion du code, qui permet a VBA, lorsqu'il connait le type d'objet qu'il manipule, de te donner les propriétés et méthodes disponible pour l'objet en question, tu sais donc de suite de quoi tu disposes pour travailler sur ton objet.
Tu sais je n'invente pas les propriétés des objets PowerPoint, je me déplace de l'un a l'autre via les propositions de l'auto-complétion, il faut par contre réussir a interpréter et comprendre l'arborescence de l'objet. (l'explorateur d'objets est également une aide précieuse (touche F2) et celui ci ne dispose de l’arborescence de l'objet que si celui ci est défini dans les référence.

Pour ton erreur au lancement de la macro, je pense que cela vient d'une différence de version entre nos 2 références a PowerPoint.
Il te suffit de changer cette référence dans menu Outils-> Références et de trouver dans la liste la version que tu as de dispo pour PP.
Si j'ai vu juste, tu aura "(manquant)" de précisé a coté de la version de référence à PP que j'utilise.

Je te conseil de garder l'utilisation des références le temps du développement de ton code, par la suite si tu veux être tranquilles au niveau de version, tu pourras finaliser ton code en passant les Objet PP en Object.

++
Qwaz

++
Qwaz
28/01/2011, 13h58
fidecourt

Bien noté, je vais m'y remettre cette après-midi et appliquer ta méthodologie
merci de tous ses conseils et explications:ccool: