Discussion :

[cha_choux]

Je crois que ca fonctionne...
Je finis de tout remonter et je vous dis !

[cha_choux]

Ca ne fonctionne pas, je ne sais plus vraiment quoi faire

J'ai crée à la chaine une trentaine d'objet avec ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub textBox()
    Dim myTextBox As Shape
    With ActivePresentation.Slides(2)
        Set myTextBox = .Shapes.AddTextbox _
           (Orientation:=msoTextOrientationHorizontal, Left:=100, Top:=50, _
            Width:=400, Height:=100)
        myTextBox.TextFrame.TextRange.Text = "new"
    End With
End Sub

Pour vérifier que j'ai bien des objets de 1 à 30 je l'ai numérote

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub modif()
    Dim myTextBox As Shape
    With ActivePresentation.Slides(2)
        'ActivePresentation.Slides(2).Shapes(1).TextFrame.TextRange.Text = "toto"
        For i = 1 To 30
        ActivePresentation.Slides(2).Shapes(i).TextFrame.TextRange.Text = i
        Next i
    End With
End Sub

A regardé j'ai bien mes 30 numéros
Dans le code je mets une condition, si la shape(1) = B1 j'implémente, mais ca ne fonctionne pas du coup je me dis c'est pas grave je vais rajouter une boucle pour vérifier tous les shapes et ca ne fonctionne pas non plus

A savoir qu'au début ca fonctionnait, puis la shape 1 s'implémentait avec la données 2 du Array, donc j'ai rajouté "A1" pour éviter le probleme sans comprendre pourquoi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Cellules = Array("A1", "B1", "B2", "B3", "B4", "B5", "B6", "C2", "C3", "C4", "D2", "D3", "D4", "D5", "E2", "E3", "E4", "E5", "F2", "F3", "F4", "F5", "G2", "G3", "G4", "G5", "I2", "I3", "I4", "I5", "J2", "J3", "J4", "J5", "K2", "K3", "K4", "K5", "L2", "L3", "L4", "L5", "M2", "M3", "M4", "M5", "N2", "N3", "N4", "N5", "O2", "P2")
 
            For i = 2 To ActivePresentation.Slides.Count 'Boucle PowerPoint
            MsgBox "tutu"
            For Z = 1 To 32
               If ActivePresentation.Slides(i).Shapes(Z).TextFrame.TextRange.Text = Range("B1") Then
                   Sheets(NomFeuille).Activate
                    MsgBox "titi"
                   For j = 1 To 32
                       ActivePresentation.Slides(i).Shapes(j).TextFrame.TextRange.Text = Range(Cellules(j))
                      ' MsgBox "toto"
                   Next j
              End If
            Next Z
            Z = 1
            Next i

Si quelqu'un a une idée je suis preneuse
PS : j'ai essayé le ActivePresentation.Slides(i).Shapes(j).TextFrame.TextRange.Text = ws.Name mais ca ne fonctionne pas

[Jean-Philippe André]

Je pense que tu as fait marche arriere par rapport au code propose quelques posts plus tot

Pour savoir ce qu;'il se passe, pense a mettre des points d'arret (F9) pour voir le contenu de tes variables et textbox.

Lorsque le code s'arretera au niveau de ta ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If ActivePresentation.Slides(i).Shapes(Z).TextFrame.TextRange.Text = Range("B1") Then

regarde ce qui vaut quoi.

A noter que Range("B1") retourne la valeur de la feuille du classeur actif =]

[cha_choux]

Mdr effectivement c'est trop facile si je ne recule pas

Je viens de finir cette partie de code et ca a l'air d'être bien supporter.
En bonus j'ai ajouté la création d'une nouvelle slide s'il ne trouve pas correspondance entre Excel et PWP

Bon... Je vais essayer d'ajouter les derniers shapes et le côté girly et prier pour qu'il continu à être sympa avec moi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
    '=======> Boucle pour passer sur chaque Feuille de l'Excel <========
    Do Until k < m  'Boucle Excel
        NomFeuille = Workbooks(Fichier).Sheets(k).Name
        Sheets(NomFeuille).Activate
 
        '=======> Tableau des données à récupérer dans cheque feuille Excel <========
        Cellules = Array("A1", "B1", "B2", "B3", "B4", "B5", "B6", "C2", "C3", "C4", "D2", "D3", "D4", "D5", "E2", "E3", "E4", "E5", "F2", "F3", "F4", "F5", "G2", "G3", "G4", "G5", "I2", "I3", "I4", "I5", "J2", "J3", "J4", "J5", "K2", "K3", "K4", "K5", "L2", "L3", "L4", "L5", "M2", "M3", "M4", "M5", "N2", "N3", "N4", "N5", "O2", "P2")
            '=======> on boucle sur l'ensemble des slides <========
            For i = 2 To ActivePresentation.Slides.Count 'Boucle PowerPoint
                For Z = 1 To 32
                     '=======> Pour chaque slide on vérifie s'il l'un des Shape est égal au nom du projet <========
                     If ActivePresentation.Slides(i).Shapes(Z).TextFrame.TextRange.Text = Range("B1") Then
                          Sheets(NomFeuille).Activate
                              For j = 1 To 32
                                  ActivePresentation.Slides(i).Shapes(j).TextFrame.TextRange.Text = Range(Cellules(j))
                              Next j
                          l = 1 'Variable pour savoir si la feuille Excel à une diapo Powerpoint
                    End If
                Next Z
            Next i
 
            '=======> Si aucune slide correspondant au projet est trouvée on crée la slide <========
            If l = 0 Then
                Set newSlide = ActivePresentation.Slides(2).Duplicate
                Sheets(NomFeuille).Activate
                    For j = 1 To 32
                        ActivePresentation.Slides(3).Shapes(j).TextFrame.TextRange.Text = Range(Cellules(j))
                    Next j
            End If
            l = 0
 
            '=======> On arrête la boucle Excel sur la feuille 3 <========
            If k = 3 Then Exit Do
            k = k - 1
    Loop

[cha_choux]

Le code fonctionne, mais dès que j'ajoute des labels pour habiller toutes ces shapes, le code plante.
Et quand je supprimer simplement les labels, le code refonctionne, mais toutes les shapes se décalent au niveau des valeurs quelles contiennent

Avec vous une idée pour palier a ce problème ?
Pas simple quand on se fie uniquement à des chiffres sans même les voir.

[Jean-Philippe André]

Le gros soucis que tu as dans ton code, c'est le fait que tu passes en mode bourrin les shapes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Shapes(Z)

Or, les shapes peuvent etre des labels, des objets de toutes sortes.

Si tu veux aller au plus simple (selon moi)

-soit tu ne gardes que tes textboxs au moment de l'alimentation et tu ajoutes dynamiquement ensuite les labels qui te plaisent
- soit tu fais en sortes de nommer tes shapes en amont (transformant les noms si necessaire) de tels sortent a passer non pas par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Shapes(Z)

mais par (par exemple)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Shapes("ZoneDediee" & Z)

[cha_choux]

Merci pour ton retour c'est gentil
J'avais nommé toutes mes textbox dans ma version précédente mais le code fonctionnait pas

Effectivement je trouve aussi que c'est très fragile comme code, et si un des utilisateurs bouge le moindre élément ca risque de péter...

Aurais tu un bout de code me permettant de rajouter un préfixe à toutes les shapes ? (je vais tenter un shapes(1).Name = "Toto1")
De sorte d'utiliser ton fameux code Shapes("ZoneDediee" & Z)
Et ainsi ne pas être embêté par mes autres éléments (images, labels, rectangle, etc)

Merci d'avance

[Jean-Philippe André]

Hum, dans l'idee

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
For Each sh in Shapes
if sh.Type=msoTextBox Then
'ici ce que tu veux faire
End if
Next

[cha_choux]

Avec le code de Philippe Jochmans, j'ai renommé une dizaine de shape par "Element 1", "Element 2", etc
PS : j'ai essayé ton code mais j'étais jeté par ma ligne de commande que j'ai rajouté pour renommé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Sub RenommerShapes()
    '=======================================================================================
    ' Procedure    : RenommerShapes
    ' Auteur       : Philippe JOCHMANS - http://starec.developpez.com
    ' Date         : 19/04/2008
    ' Commentaires : Cette procédure va permettre de renommer les shapes de slides
    '=======================================================================================
 
    ' ===== déclaration des variables =====
    Dim objSld As Slide         ' va permettre de parcourir les diapositives du diaporama
    Dim objShp As Shape         ' va permettre de parcourir les éléments d'une diapositive
    Dim strNom As String        ' pour récupérer le nouveau nom
    Dim strMessage As String    ' message qui sera affiché dans la boite de demande du nom
 
    ' ===== boucle ======
    ' on boucle sur l'ensemble des diapositives
    For Each objSld In ActivePresentation.Slides
        objSld.Select
        ' on boucle sur l'ensemble des shapes
        For Each objShp In objSld.Shapes
            ' création du message qui indiquera slide + shape
            objShp.Select
            strMessage = "Elément sélectionné :" & vbCrLf & _
                         "- Slide : " & objSld.Name & vbCrLf & _
                         "- Shape : " & objShp.Name
            strNom = InputBox(strMessage, "Modification des noms", objShp.Name, 0, 0)
            ' contrôle du nom
            ' si on supprime le nom, on reprend l'ancien
            If strNom = "" Or IsNull(strNom) Then
                strNom = objShp.Name
            End If
            objShp.Name = strNom
        Next objShp
    Next objSld
End Sub

Quand je modifier mes lignes de code par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
For Z = 1 To 10
                     '=======> Pour chaque slide on vérifie s'il l'un des Shape est égal au nom du projet <========
                     If ActivePresentation.Slides(i).Shapes("Element " & Z).TextFrame.TextRange.Text = Range("B1") Then
                          Sheets(NomFeuille).Activate
                              For j = 1 To 10
                                  ActivePresentation.Slides(i).Shapes("Element " & j).TextFrame.TextRange.Text = Range(Cellules(j))
                              Next j
                          l = 1 'Variable pour savoir si la feuille Excel à une diapo Powerpoint
                    End If

J'ai un message d'erreur m'indiquant que l'item Element 1 n'est pas trouvé dans la collection
As tu une idée ? Je suis désolée de te solliciter autant, mais je commence à fatiguée de ce projet (je ne suis pas développeuse et mes collegues développent dans des langages comme Adélia)

Mon responsable m'a dit de laisser tomber si ce n'est pas résolu ce soit, mais je serais extrêmement déçue et frustrée que le tout ne soit pas automatisé surtout qu'il ne reste plus grand chose

[Jean-Philippe André]

En mettant un espion sur l'objet ActivePresentation.Slides(i).Shapes() au moment de l'execution de ton code, que vois-tu ?

[cha_choux]

Voici pour les deux façons.
Le passage de la souris sur le mot shape ne donne rien



Et pourtant dans le code de Philippe le shape s'appelle bien Element1


Et voici les propriétés que me donne PWP


Je m'excuse je n'ai pas trouvé comment vous envoyé sur le site le PWP (l'Excel est accepté mais pas un PWP avec macro)

[cha_choux]

En mettant MsgBox "- Slide : " & ActivePresentation.Slides(i).Shapes(Z).Name en espion dans mon code, il me renvoi Element1
Donc j'ai changé mon code par ActivePresentation.Slides(i).Shapes(Z).TextFrame.TextRange.Text = Range("B1") Then

Je vérifie si en ajoutant un label ou autre et il me rejette de nouveau : "La valeur tapée est en dehors des limites"

[cha_choux]

J'ai une petite idée qui va peut être me sortir de ce problème
Je vais ajouter une condition vérifiant que le préfixe des shapes = Element

[cha_choux]

Jean Philippe,

Serais tu me dire pourquoi :

- Quand j'ai 3 shapes, que j'appelle "Element1", "Element2", "Element3"
- Que je fais une boucle pour regarder leur name ca me donne l'ordre "Element1", "Element2", "Element3"
- Si je fais une modification sur "Element3" (juste le mettre au premier plan par exemple) et que je relance ma boucle, ca me donne "Element3", "Element1", "Element2" ?

Du coup ca dégomme mon algo au passage, et ca décale toutes mes données d'un cran

[Jean-Philippe André]

La boucle sur les collections d'objets (ici les shapes) se fait dans un ordre qui va dependre de l'application.

Sans certitude, je dirais que l'ordre est pris selon l'ordre de tabulation qui serait utilise dans ton formulaire ==ordre de creation/modification

[clementmarcotte]

Bonjour,

De toutes façons, tu es bien mal parti. J'ai fait des tests hier et le seul moyen que j'ai trouvé pour mettre quelque chose dans un textbox passe par cliquer sur le Textbox. J'ai cherché dans MSDN et je n'ai pas trouvé de documentation sur msoOLEControlObject . (Dernière heure, je viens de trouver un bout de code pour Excel. Pas le temps de tester pour l'instant)

Sinon, j'ai une piste pour le faire à partir de cadres de texte, mais je n'ai pas eu le temps de tout valider.

[clementmarcotte]

Bonjour,

Je n'ai pas réussi à adapter le code Excel à Powerpoint. Ceci dit, j'ai une solution sans Textbox, mais personne ne devrait en mourir.

Dans le fichier ci-joint je t'ai mis une macro qui marche.

Pour ceux que cela pourrait intéresser mais qui hésitent à ouvrir les fichiers-joints, (et c'est normal) voici ce que j'ai fait:

1) J'ai mis trois cadres de texte, et une autre forme sur une diapositive.
2) Dans la mise en forme des cadres de textes (sélectionner et clic-droit), je leur ai mis un titre à chacun

3) J'ai fait tourner la macro dans PowerPoint:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Sub Test()
    For Each forme In ActivePresentation.Slides(1).Shapes
        Select Case forme.Title
            Case "Clément"
                forme.TextFrame.TextRange = "Clément"
            Case "Hector"
                forme.TextFrame.TextRange = "Hector"
            Case "Séraphin"
                forme.TextFrame.TextRange = "Séraphin"
            Case Else
                MsgBox ("Triangle")
        End Select
    Next
End Sub

Et les 3 cadres de texte ont un texte.

Maintenant, il suffit de remplacer les texboxes par un cadre de texte, de donner un titre distinct aux cadres qui doivent en avoir un et d'adapter la macro à Excel. (Pour faire correspondre les titres et les valeurs, ce ne sont pas les choix qui manquent. )
Simonac.zip