Mise en forme PowerPoint à partir d'Excel

Bonjour à tous

Voilà j'ai besoin de pouvoir extraire des informations de Excel et de les importer dans PowerPoint pour faire une mise en forme. L'idée est de prendre les informations qui m'interessent à partir d'un tableau excel (colonne "Groupe" et "Mobilier") puis de créer une Shape à chaque texte transférer dans PowerPoint.

Donc déjà le fichier Excel avec une macro qui est censé envoyé chaque texte dans Powerpoint

Je ne comprends pas, mon code fonctionnait, puis j'ai du supprimer par erreur quelque chose et ça ne fonctionne plus....

Pouvez vous dejà m'éclairer et me dire ce qui cloche dans mon code.

Ensuite une fois que les shapes sont crées dans un fichier Powerpoint, je dois les ranger.

Beaucoup de problèmes à ce niveau !!!

D'abord, je ne suis pas familiariser avec le vba sur Pwp et je n'arrive même pas à créer un bouton pour lancer mes macros...

1° problème

donc ma question : ben on fait comment?

Ensuite, la macro mise_en_forme permet de réduire la police des shapes, de les alignés, de les séparer,...

Bref, ça au moins ça fonctionne

Puis je créer des flèches avec la macro fleche, mais le problèmes c'est leur manipulation.

J'aimerais pouvoir changer leurs couleurs, leurs dimensions,... mais déjà je n'arrive pas à les sélectionner autrement que une par une. Je pensais qu'en leur donnant à toute le même nom je pourrais toutes les manipuler ensemble, mais je n'y arrive pas.

Set fleche = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeBentArrow, 20 + i * m, 20 + i * m, 100, 20)
fleche.Name = "fleche"
ActivePresentation.Slides(1).Shapes.Range(Array("fleche")).Select

Ce code ne me permet de manipuler qu'une seule shape à la fois, j'aurais cru pouvoir toute les selectionner d'un seul coup.

Auriez vous une idée?

Bonjour,

Un exemple à partir du fichier Excel :

Nb : J'ai détordu les flèches .

Option Explicit

Sub Creation_FichierPpt()

Dim I As Integer, NbShapes As Integer
Dim AireTruc As Range, AireNum As Range, AireMachin As Range, AireBidule As Range
Dim PosX As Single, PosY As Single, LePasY As Single
Dim Repertoire As String

' En phase de développement, déclarer la référence Power point pour bénéficier de l'intellisense.
' C'est à dire un . derrière l'object donne accès à ses propriétés, méthodes et événements.
Dim PptApp As PowerPoint.Application 'Object 'la variable qui contiendra l'application
Dim PptPre As PowerPoint.Presentation 'Object 'la variable qui contiendra la présentation
Dim PptSld As PowerPoint.Slide
Dim PptShp As PowerPoint.Shape 'Object   'pour manipuler un objet Forme

    Set AireTruc = Range("Tableau1[Truc]")
    Set AireNum = Range("Tableau1[N°]")
    Set AireMachin = Range("Tableau1[Machin]")
    Set AireBidule = Range("Tableau1[Bidule]")

    Set PptApp = CreateObject("Powerpoint.Application")
    With PptApp
         .Visible = msoTrue
         Set PptPre = .Presentations.Add 'créer le fichier powerpoint et un slide
    End With
    Set PptSld = PptPre.Slides.Add(Index:=1, Layout:=ppLayoutBlank)

    Repertoire = ThisWorkbook.Path
    PosX = 50: PosY = 30: LePasY = 50

    For I = 1 To AireTruc.Count
        If AireTruc(I) <> "" Then
           Set PptShp = PptSld.Shapes.AddShape(msoShapeRectangle, PosX, PosY, 100, 30)
           With PptShp
                .Name = AireTruc(I) & "_" & AireBidule(I)
                With .TextFrame.TextRange
                     .Text = AireTruc(I) & " - " & AireBidule(I)
                     .Font.Size = 12
                End With
           End With
           ' Création de la flèche
           CreationFleche PptSld, AireTruc(I) & "-" & AireBidule(I), PosX + 100, PosY + 5, 50, 20
           PosY = PosY + LePasY
        End If
    Next I

    With PptPre
         .SaveAs Repertoire & "\AAA", ppSaveAsDefault
     '    .Close
    End With

   ' PptApp.Quit

    Set AireTruc = Nothing: Set AireNum = Nothing: Set AireMachin = Nothing: Set AireBidule = Nothing
    Set PptApp = Nothing: Set PptPre = Nothing: Set PptSld = Nothing

End Sub

Sub CreationFleche(ByVal PptSld2 As PowerPoint.Slide, ByVal ShapeNom As String, ByVal PosX As Single, ByVal PosY As Single, ByVal LongX As Single, ByVal HauteurY As Single)

Dim PptShp As PowerPoint.Shape

     With PptSld2
          Set PptShp = .Shapes.AddShape(msoShapeRightArrow, PosX, PosY, LongX, HauteurY)
          With PptShp
               .Name = "Flèche_" & ShapeNom
          End With
     End With

End Sub