Les exemples proposés nécéssitent d'activer la référence "Microsoft Powerpoint x.x Object Library"
Dans l'éditeur de macros:
Menu Outils
Références
Cochez la ligne "Microsoft Powerpoint x.x Object Library"
Cliquez sur OK pour valider
(x.x dépend de la version d'Office installée sur votre poste.)
créer une présentation PPT
********************
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
| Sub NouvellePresentation()
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.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 = "monGraph" '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
'Sauvegarde la présentation
'dans le meme répertoire que le classeur excel contenant la macro.
PptDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & "NouvellePresentation.ppt"
'ferme la presentation
PptDoc.Close
'ferme powerpoint
PptApp.Quit
MsgBox "Opération terminée."
End Sub |
Modifier une présentation
********************
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
| Sub ModifierPresentationExistante()
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Set PptApp = CreateObject("Powerpoint.Application")
PptApp.Visible = True
Set PptDoc = PptApp.Presentations.Open("C:\LaPresentation.ppt")
With PptDoc
'copie la plage de cellules dans la feuille Excel active
Feuil1.Range("B1:H5").Copy
'Effectue un collage dans la 2eme diapositive
.Slides(2).Shapes.Paste
With .Slides(2).Shapes(.Slides(2).Shapes.Count)
.Name = "monTableau" 'Renomme l'objet collé
.Left = 150 'position horizontale dans le slide
.Top = 100 'position verticale dans le slide
.Height = 300 'hauteur
.Width = 400 'largeur
End With
'insère le contenu de la cellule A1 dans la deuxième zone de texte,
'du 3eme slide
.Slides(3).Shapes(2).TextFrame.TextRange.Text = Range("A1")
'sauvegarde la présentation
.Save
End With
'ferme la présentation
PptDoc.Close
'ferme powerpoint
PptApp.Quit
End Sub |
Comment masquer totalement powerPoint pendant l'éxécution d'une macro.
****************************************
Indiquez l'argument WithWindow:=msoFalse lors de l'ouverture de la présentation.
Cette solution ne permet pas l'utilisation de la méthode Select lors de la manipulation du fichier PPT.
Set pptDoc = pptApp.Presentations.Open("C:\maPresentation.ppt", WithWindow:=msoFalse)
Changer la source d'un classeur lié, dans une présentation powerPoint
********************************************
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
| Dim pwrPoint As PowerPoint.Application
Dim Prez As PowerPoint.Presentation
Dim targetMaj As String
Dim Forme As PowerPoint.Shape
Dim Diapo As PowerPoint.Slide
Presentation = ThisWorkbook.Path & "\maPresentation.ppt"
'Le nouveau classeur lié
targetMaj = ThisWorkbook.Path & "\monClasseurMisAJour.xls"
Set pwrPoint = CreateObject("PowerPoint.Application")
pwrPoint.Visible = msoTrue
Set Prez = pwrPoint.Presentations.Open(Presentation)
'Boucle sur les Slide de la présentation
For Each Diapo In Prez.Slides
'Boucle sur les formes
For Each Forme In Diapo.Shapes
'Vérifie s'il s'agit d'un objet lié
If Forme.Type = msoLinkedOLEObject Then
'Vérifie si l'objet lié est un objet Excel
If Forme.OLEFormat.progID = "Excel.Sheet.8" Then
'Modifie la source
Forme.LinkFormat.SourceFullName = targetMaj
'Mise à jour
Forme.LinkFormat.Update
End If
End If
Next
Next
Prez.Save
'ferme la présentation
Prez.Close
'ferme powerpoint
pwrPoint.Quit |
Mettre à jour les données d'un graphique Excel incorporé dans une présentation
*******************************************
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
| Sub MAJ_graphiqueDansPresentation()
Dim appPPT As PowerPoint.Application
Dim Sh As PowerPoint.Shape
Dim Gr As Workbook
Set appPPT = CreateObject("PowerPoint.Application")
appPPT.Visible = msoTrue
appPPT.Presentations.Open "C:\maPresentation.ppt"
'Copie une plage de cellules dans la feuille active
'Ces données vont être collées dans le classeur incorporé, dans ppt, servant
'de source pour le graphique.
ActiveSheet.Range("A1:G10").Copy
'Le classeur incorporé est dans le 1er Slide
With appPPT.ActivePresentation.Slides(1)
'Boucle sur les formes pour retrouver l'objet Excel
For Each Sh In .Shapes
'Verifié s'il s'agit d'un objet incorporé
If Sh.Type = msoEmbeddedOLEObject Then
'Vérifie s'il s'agit d'une feuille graphique
If Sh.OLEFormat.progID = "Excel.Chart.8" Then
Set Gr = Sh.OLEFormat.Object
'Colle les données dans la Feuil1 du classeur incorporé
'La feuil1 contient la source de données pour le graphique
Gr.Sheets("Feuil1").Range("A1").PasteSpecial
'réactive la première feuille du classeur incorporé
'(Le graphique est situé dans ce 1er onglet)
Gr.Sheets(1).Activate
End If
End If
Next Sh
End With
End Sub |
Insérer des diapositives provenant d'une autre présentation (fermée) dans la présentation ouverte
*********************************************
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
| Sub piloterPowerPoint()
Dim Ppa As PowerPoint.Application
Dim Ppp1 As PowerPoint.Presentation
Set Ppa = New PowerPoint.Application
Ppa.Visible = True
'Ouverture présentation
Set Ppp1 = Ppa.Presentations.Open(Filename:="C:\maPresentation1.ppt")
'expression.InsertFromFile(CheminPresentationSource, Index, SlideDebut, SlideFin)
'---------------------------------------------------------------
'Cet exemple montre comment insérer les diapositives 1 à 4 provenant
'de "PresentationSource.ppt" à la suite de la diapositive 2, dans
'la présentation "maPresentation1.ppt".
Ppp1.Slides.InsertFromFile "C:\PresentationSource.ppt", 2, 1, 4
End Sub |
Calculer la durée d'une présentation dont les Slides sont paramétrés pour défiler automatiquement
*********************************************
L'influence éventuelle des vitesses et style de transition n'est pas prise en compte
1
2
3
4
5
6
7
8
| Dim i As Integer
Dim x As Long
For i = 1 To Prez.Slides.Count
x = x + Prez.Slides(i).SlideShowTransition.AdvanceTime
Next i
MsgBox x |
[VBA Excel] Piloter PowerPoint
Répondre avec citation
Envoyé par SilkyRoad
Partager