numerotation des Shapes

[ouioui_cmoi]

Bonjour
Pour supprimer des Shapes, j'utilise le code suivant :

For Each Shapes In PptDoc.Slides(2).Shapes
   PptDoc.Slides(2).Shapes(1).Delete
    Next

Mais, j'ai plusieurs shapes par page, et je n'arrive pas du tout à comprendre le systeme de numerotation de powerpoint, et du coup, je supprime les mauvaises shapes...
Quelqu'un pourrait t il m'expliquer comment Powerpoint les numerote,s il vous plait?

[Philippe JOCHMANS]

Bonjour

PowerPoint numérote les shapes dans l'ordre de création, et non de la position de celles-ci sur la feuille.

Avec ton code tu supprimes la première qui a été crée, si tu relances ton code tu supprimes la deuxième crée qui est devenue la première car tu as supprimé l'autre avant.

Les solutions :

• Supprimer le type de shapes : PowerPoint nomme les shapes Rectangle1, Oval 1, et ainsi de suite, le numéro s'incrémentant au fur et à mesure, met ne se met pas à zéro.
• Nommer tes shapes lors de la création par le code.

Sous PowerPoint 2007 une nouvelle fonction permet de nommer les shapes en leur donnant un nom significatif, ce qui permet de les désigner sans problème.

Si tu détaillais un peu plus le but de ta suppression et ce que tu veux faire, on pourrait peut-être trouver une solution.

Starec

[ouioui_cmoi]

En fait voila, je t'explique le probleme:
J'ai créé une macro qui exporte des Tableaux et Graphiques vers powerpoint.
Mon code permet d'actualiser un fichier powerpoint:
Donc il est lancé a peu pres chaque semaine. Mon code nomme les tableaux et graphes qu'il colle dans powerpoint.
Si on ne fait que lancer la macro, ma macro cherche dans powerpoint les noms que j'ai donné aux tableaux, et colle les nouveaux.
La macro marche sans problème.
Néanmoins, il arrive à mes collègues de deevoir copier-coller ces tableaux et graphiques à la main, et alors, le nom n'est plus reconnu, et le programme plante, car il ne trouve pas l'objet à supprimer...
Voila mon probleme
J'ai pas acces au code pour l instant, mais je peux l' envoyer cet aprem si tu veux bien m'aider...

[Philippe JOCHMANS]

Re

Envoyé par ouioui_cmoi

J'ai pas acces au code pour l instant, mais je peux l' envoyer cet aprem si tu veux bien m'aider...

Sans problème, par contre quelle version de PPT as-tu ?
De plus ce sera ce soir ou demain matin.

Starec

[ouioui_cmoi]

lol j'ai la version :
Powerpoint 2002 SP3

Et ok ce sera ce soir ou demain matin, pas de pb
merci d avance

[ouioui_cmoi]

Voila le code...

Public Sub ModifierPresentationExistantedb()
 
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Set PptApp = CreateObject("Powerpoint.Application")
PptApp.Visible = True
 
 
 
 
With Application.FileSearch
        .NewSearch
        .LookIn = "G:\ 2008\"
        .Filename = "DB*.ppt"
        .Execute
        
       Nombre_Fichier = .FoundFiles.Count
       
       For Each Fichier In .FoundFiles
       
      
        If Fichier = "G:\ 2008\DB " & Format(Now, "yyyy - mm - dd") & ".ppt" Then
        Fichier1 = Fichier
 
       Next
       If Fichier1 = "" Then
       MsgBox ("Fichier DB non trouvé : vérifier que le fichier est de la forme 'DB yyyy - mm - dd' et date de moins de 2 semaines")
       GoTo fin
       End If
       
End With
 
Set PptDoc = PptApp.Presentations.Open(Fichier1)
With PptDoc
 
   Worksheets("DB").Activate
   Range("A1").Select
   
 
a = 3
Do While Cells(a, 1).Value <> ""
    a = a + 1
Loop
a = a + 1
Do While Cells(a, 1).Value <> ""
    a = a + 1
Loop
a = a + 1
Do While Cells(a, 1).Value <> ""
    a = a + 1
Loop
a = a - 1
 
    'tableau
    
    ActiveSheet.Range("A2:H" & a).Copy
 
   PptDoc.Slides(2).Shapes("dbtableau").Delete
    .Slides(2).Shapes.PasteSpecial ppPasteEnhancedMetafile
 
    
    With .Slides(2).Shapes(.Slides(2).Shapes.Count)
        .Name = "dbTableau"
        .LockAspectRatio = msoFalse
        .Width = 360
        .Height = 350
        .Left = 90
        .Top = 130
        
End With
 
    '4 graphes
 
     ActiveSheet.Shapes.Range(Array("Chart 2", "Chart 1", "Chart 4", "Chart 3")).Select
    Selection.Copy
 
 
   PptDoc.Slides(3).Shapes("dbTableau1").Delete
 
    .Slides(3).Shapes.PasteSpecial ppPasteEnhancedMetafile
 With .Slides(3).Shapes(.Slides(3).Shapes.Count)
        .Name = "dbTableau1"
        .LockAspectRatio = msoFalse
        .Width = 700
        .Height = 450
        .Left = 40
        .Top = 70
        
End With
 
    '3 graphes
 
      Worksheets("DB").Activate
    ActiveSheet.Shapes.Range(Array("Chart 7", "Chart 8", "Chart 6")).Select
    Selection.Copy
 
 
   PptDoc.Slides(4).Shapes("dbTableau2").Delete
 
    .Slides(4).Shapes.PasteSpecial ppPasteEnhancedMetafile
 With .Slides(4).Shapes(.Slides(4).Shapes.Count)
        .Name = "dbTableau2"
        .LockAspectRatio = msoFalse
        .Width = 700
        .Height = 460
        .Left = 40
        .Top = 70
        
End With
 
 
   .SaveAs ("G:\ 2008\DB " & Format(Now, "yyyy - mm - dd") & ".ppt")
End With
PptDoc.Close
PptApp.Quit
fin:
 
Finduprog:
Worksheets("DB").Activate
Range("A1").Select
 
End Sub
 

[Philippe JOCHMANS]

Bonjour

Avant d'aller plus loin, tu vas essayer de lancer le bout de code suivant.

Comme tu dis que tu nommes les objets que tu inséres, lorsque tes collégues insérent des objets, ils ne sont pas nommés.

Hors je te disais précédemment que PPT insére les objets en leur donnant un nom, et en ajoutant un numéro qui s'incrémente.

Le code suivant va boucle sur la diapositives et les formes de ta présentation, ensuite il va faire un test sur le nom, et détruire l'objet s'il s'agit d'un objet nommé par ppt.

Public Sub SuppressionObjet()
    Dim shp As Shape
    Dim sld As Slide
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            If Left(shp.Name, 6) = "Object" Then
                shp.Delete
            End If
        Next shp
    Next sld
End Sub

Tu mets ce codes dans un module, tu positionnes le curseur à l'intérieur et tu appuis sur F5.

Cela devrait nettoyer ton fichier.

Starec

[ouioui_cmoi]

J'ai lancé ton programme dans mon powerpoint, mais ca n a pas l'air d avoir d'effet.
Au fait, je n'ai pas précisé: je savais comment supprimer mes shapes lorsque je veux supprimer outes les shapes d'une slide, mais le pb, c'est que, de part la mise en forme du ppt; y a des shapes qu'il ne faut pas que je supprime, et le problème vient de là....

[Philippe JOCHMANS]

Re

Envoyé par ouioui_cmoi

J'ai lancé ton programme dans mon powerpoint, mais ca n a pas l'air d avoir d'effet.

Le petit essai que j'ai fait à fonctionné

Au fait, je n'ai pas précisé: je savais comment supprimer mes shapes lorsque je veux supprimer outes les shapes d'une slide, mais le pb, c'est que, de part la mise en forme du ppt; y a des shapes qu'il ne faut pas que je supprime, et le problème vient de là....

Le code que je t'ai donné sélectionnait les objets par leur nom (donné par ppt) pour les supprimer.
Maintenant à partir du code que je t'ai fourni essayes de faire l'inverse, c'est à dire de tester les noms, et si c'est un nom que tu crées (selon un début de nom par exemple) tu ne fais rien, s'il ne correspond pas à tes critères de nom tu le supprimes.

Starec

[ouioui_cmoi]

j'ai pas le temps de regarder aujourd hui, mais j essaie demain
merci

[ouioui_cmoi]

bon, he bien merci beaucoup, ça marche bien!
J'ai approfondi, et en fait ca marchait pas parce que il fallait que je cherche "picture", et pas object
j ai encore le probleme de lancer la macro pptpar excel, mais j vais faire un nouveau sujet pour ça...
Au fait, dans le même sujet, c'est possible de renommer des shapes existantes dans ppt à la main?

[Philippe JOCHMANS]

Bonjour

Tant mieux si cela fonctionne.

Tu ne peux nommer les shapes à la main, sauf si tu as ppt 2007, c'est une nouvelle fonctionnalité qui est apparue avec cette version.

Si tout est bon, tu cliques sur , et un autre sujet pour de nouvelles aventures sous ppt.

Starec

[ouioui_cmoi]

juste pour savoir: Est il possible de limiter l'exécution de la macro à seulement quelques slide définies?
Parce que, sur mes fichiers powerpoint, j'ai des slides contenant des pictures que je ne veux pas supprimer...
(J'ai beaucoup de mal avec la syntaxe VBA de Powerpoint...)

[Philippe JOCHMANS]

Bonjour

C'est possible, il faut faire un test sur le nom du slide dans ta boucle.

Voici un exemple en reprenant le code que je t'avais donné précedemment, à toi de voir pour l'adapter à ce que tu as fait.

Public Sub SuppressionObjet()
    
    Dim shp As Shape
    Dim sld As Slide
    For Each sld In ActivePresentation.Slides
        Select Case Mid(sld.Name, 6)
            Case 1 To 5
                For Each shp In sld.Shapes
                    If Left(shp.Name, 6) = "Object" Then
                        shp.Delete
                    End If
                Next shp
            Case Else
        End Select
    Next sld
End Sub

on récupére le numéro du slide

Mid(sld.Name, 6)
 

Grâce à l'instruction select case, on ne fait l'opération que pour les slides 1 à 5, pour le reste rien.

Starec

[ouioui_cmoi]

OK Merci, j pense ca devrait marcher.
Me reste plus que le probleme de lancer ma macro sur powerpoint a partir d excel...(Sujet créé mais sans réponse...)
Donc si tu avais une idée ce serait cool! ;=)