Macro excel vers power point

Y compris Power BI, Power Query et toute autre question en lien avec Excel
b
benjaminL22
Nouveau venu
Nouveau venu
Messages : 1
Inscrit le : 20 avril 2018
Version d'Excel : 2016

Message par benjaminL22 » 20 avril 2018, 19:10

Bonjour,

Je cherche à créer une macro me permettant de faciliter la création d'un power point.

J'ai trois onglets avec des tableaux de dimensions similaires.

Aujourd'hui, je fais une impression de l'écran pour avoir une image propre, que je colle dans 3 slides différents.
Je dois également ajuster la taille et la position de l'image sur le slide.

Connaissez-vous une macro me permettant d'automatiser cette tâche ?

Merci,
Benjamin
Avatar du membre
i20100
Passionné d'Excel
Passionné d'Excel
Messages : 5'548
Appréciations reçues : 323
Inscrit le : 16 mars 2017
Version d'Excel : 2010

Message par i20100 » 21 avril 2018, 00:05

Bonjour,

voici un exemple pour 1 tableau
Sub NouvellePresentation()
'nécessite d 'activer la référence "Microsoft Powerpoint x.x Object Library"
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim Diapo As PowerPoint.Slide
Dim Sh As PowerPoint.Shape
Dim Cs1 As ColorScheme
Dim NbShpe As Integer
 
Set PptApp = CreateObject("Powerpoint.Application")
Set PptDoc = PptApp.Presentations.Add
 
With PptDoc
    
    '--- Ajoute un Slide
    .Slides.Add Index:=1, Layout:=ppLayoutBlank
    'Crée une zone de texte (AddLabel)
    Set Sh = .Slides(1).Shapes.AddLabel(Orientation:=msoTextOrientationHorizontal, _
        Left:=100, Top:=100, Width:=150, Height:=60)
    'insère la valeur de la Cellule A1 dans une zone de texte
    Sh.TextFrame.TextRange.Text = Range("A1")
    'Modifie la couleur du texte
    Sh.TextFrame.TextRange.Font.Color = RGB(255, 100, 255)
 
 
    '--- Ajoute un nouveau slide et le positionner en 2eme position
    Set Diapo = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)
    
    'copie le 1er graphique contenu dans la feuille Excel active
    ActiveSheet.Range("A1:Q69").Copy    'ActiveSheet.ChartObjects(1).Copy
    'collage dans la 2eme diapositive
    Diapo.Shapes.Paste
 
    'Compte le nombre de shapes dans la diapositive:
    'le dernier objet inséré correspond à l'index le plus élevé
    NbShpe = Diapo.Shapes.Count
 
    'Renomme et met en forme l'objet collé
    With Diapo.Shapes(NbShpe)
        .Name = "TB1" 'personnalise le nom
        .Left = 150 'définit la position horizontale dans le slide
        .Top = 100 'définit la position verticale dans le slide
        .Height = 300 'hauteur
        .Width = 400 'largeur
    End With
    
    
    '--- Modifie la couleur de fond dans les différents Slides
    Set Cs1 = .ColorSchemes(3)
    Cs1.Colors(ppBackground).RGB = RGB(225, 233, 200)
    .SlideMaster.ColorScheme = Cs1
End With
PptApp.Visible = True
End Sub
Vive ces nouvelles saisons qui nous colorent.
isabelle
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message