Creer un diaporama avec excel VBA

Version imprimable

13/08/2014, 13h33
billard-man

Creer un diaporama avec excel VBA

Bonjours,
j'organise des competition et au fur et a mesure de la competition afficher en live les et je souhaiterais lancer un diaporama avec power point des feuilles d'un classeur excel actif :
-1 ouvrir une presentation existante ppt existante dans le meme repertoire que le fichier excel (ex: C/compet/presentation.ppt)
-2 la rendre vierge
-3 y inserer 4 feuilles de mon fichier excel ouvert
-4 l'enregistrer sous "C/compet/presentation.ppt"
-5 fermer power point
-6 lancer le diaporama en b"presentation"
-7 avec la touche "esc" fermer le diaporama et revenir sur mon classeur excel.

Rq: si possible masquer les etapes 1 à 5.
13/08/2014, 14h53
kuchiky

Bonjour,

Citation:

Rq: si possible masquer les etapes 1 à 5.

Si tu manipules des shapes de ton powerpoint, tu ne pourras pas masquer l'ouverture de l'application.

Citation:

-2 la rendre vierge

Pourquoi ne pas plutôt créer un nouveau fichier PPT puis de sauvegarder par dessus l'autre?

Citation:

-3 y inserer 4 feuilles de mon fichier excel ouvert

Tes feuilles contiennent une large plage de cellule? car si tu as une colonnes de 70 lignes par exemple ce sera compliquer de le lire dans ton PPT
13/08/2014, 15h03
Menhir

Ce serait sans doute plus simple de faire ça avec du PDF plutôt que tu PPT.
Générer le PDF est plus simple que de transférer de l'Excel dans PowerPoint et il existe des outils gratuits pour faire des diaporama de PDF.
14/08/2014, 08h33
billard-man

Citation:

Envoyé par kuchiky

Bonjour,

Si tu manipules des shapes de ton powerpoint, tu ne pourras pas masquer l'ouverture de l'application.

Pourquoi ne pas plutôt créer un nouveau fichier PPT puis de sauvegarder par dessus l'autre?

Tes feuilles contiennent une large plage de cellule? car si tu as une colonnes de 70 lignes par exemple ce sera compliquer de le lire dans ton PPT

Bonjours,
Dabord merci d'avoir voullu repondre à mon problème,
- Il me semblait que l'on ne pouvait masquer ces opérations dans mon cas, mais j'avais espérer que ........ tans pis je me contenterais de le laisser apparent .
- la solution de creer un fichier ppt puis de le sauvegarder par dessus l'autre me semble une bonne solution, a condition que je puisse le monbre de diapo (passer de 4 diapo "fichier dernierement sauvegardé" à 3 diapo "nouveau ficier".
- En fait se serait une plage de cellule de 51 lignes x 26 colones.
14/08/2014, 09h57
kuchiky

Bonjour,

Citation:

a condition que je puisse le monbre de diapo (passer de 4 diapo "fichier dernierement sauvegardé" à 3 diapo "nouveau ficier".

Le nombre de diapo dépendrai du nombre de feuille que tu as?

Citation:

- En fait se serait une plage de cellule de 51 lignes x 26 colones.

Je vien de tester une copie de 51*26 cellules puis de le coller sur une diapo (en la redimensionnant sur toute la longueur et largeur) et.... c'est totallement illisible. Essaye à la main et tu verras :mouarf:
14/08/2014, 10h56
billard-man

Citation:

Envoyé par Menhir

Ce serait sans doute plus simple de faire ça avec du PDF plutôt que tu PPT.
Générer le PDF est plus simple que de transférer de l'Excel dans PowerPoint et il existe des outils gratuits pour faire des diaporama de PDF.

L'affichage en live se ferait toutes les 10 min (au fur et a mesure des saisies de resultats)sur 8 heures de competition, c'est pour cela que j'esperais le faire en automatique par le biais d'une macro activée par un bouton "affichage".
14/08/2014, 11h05
Menhir

Je ne vois pas en quoi ce que tu décris serait incompatible avec la solution de passer par un PDF.
Dans les deux cas, il s'agit de générer un fichier et de l'ouvrir avec un logiciel.
A moins que tu comptes modifier ton fichier PPT alors qu'il est en cours de diaporama.
14/08/2014, 11h24
billard-man

Citation:

Envoyé par kuchiky

Bonjour,

Le nombre de diapo dépendrai du nombre de feuille que tu as?

Je vien de tester une copie de 51*26 cellules puis de le coller sur une diapo (en la redimensionnant sur toute la longueur et largeur) et.... c'est totallement illisible. Essaye à la main et tu verras :mouarf:

un bouton "affichage" ouvrirait une boite de dialogue avec 3 boutons options :
1 - 3 diapos (3 plages de cellules, une plage par feuille) a afficher dans le diaporama (feuil1, feuil2, feuil3)
2 - 1 diapo (1 plage de cellules) a afficher dans le diaporama (feuil4)
3 - 4 diapos (4 plages de cellules, une plage par feuille) a afficher dans le diaporama (feuil1, feuil2, feuil3, feuil4)
C'est pour cela que mon fichier ppt doit etre rendu vierge avant de creer une diapo.

Je viens d'essayer, Ca passe juste (les largeurs de colones sont variables et peu larges).

Citation:

Envoyé par Menhir

Je ne vois pas en quoi ce que tu décris serait incompatible avec la solution de passer par un PDF.
Dans les deux cas, il s'agit de générer un fichier et de l'ouvrir avec un logiciel.
A moins que tu comptes modifier ton fichier PPT alors qu'il est en cours de diaporama.

La solution avec le PDF ne me gene pas, mais je ne veux pas perdre de temps a lancer un logiciel, charger mes fichiers "PDF"et lancer le diaporama, tout ca manuellement
Avec VBA on peu generer du PDF ?
Quel logiciel faut-il pour le diaporama peu-t-on le piloter avec VBA ?
14/08/2014, 11h56
Menhir

Citation:

Envoyé par billard-man

Avec VBA on peu generer du PDF ?

Avec PDFCreator, ça ne pose aucun problème.
Il y a de nombreux exemple dans ce forum.
De plus, quand on l'installe, il met dans un de ses répertoire des exemples de code VBA qui peuvent être quasiment copié/collé ou, au moins, être utilisés comme didacticiels prémachés.

Citation:

Quel logiciel faut-il pour le diaporama peu-t-on le piloter avec VBA ?

En libre, le seul bon lecteur que je connaisse est Sumatra : http://blog.kowalczyk.info/software/...reader-fr.html
Il peut se lancer en ligne de commande donc on peut le lancer avec du VBA mais je n'ai jamais essayé de le piloter en VBA. Je ne sais pas si sa bibliothèque d'objets est accessible.
Cela dit, sur la page que je t'ai indiquée, il y a un lien vers un forum. Ils pourront peut-être répondre à ce type de question.

-----------------------------------------------------------------
EDIT
J'oubliais que depuis Excel 2007, il est possible de générer du PDF avec Excel sans outils supplémentaire.
Je ne peux pas te donner le code (par habitude, je continue à utiliser PDFCreator, y compris dans les macros) mais l'enregistreur automatique de macro pourra certainement te fournir ça.

J'ai fais des recherches hier soir et j'ai glané a gauche et a droite des infos.
j'arrive a creer un ppt, a y inserer des diapos, a y copier des plages de cellules, l'enregistrer (ppt et pps), sous le meme repertoire que mon fichier excel et le tout masquer.
a lancer le diaporama (pps), et supprimer les deux fichiers "NouvellePresentation.ppt" et "NouvellePresentation.pps".

il me reste quelques problèmes :
- je n'arrive pas a parametrer dans le ppt : le temps d'exposition d'une diapo, la transition (temps et type), le mode defilement automatique, mode boucle.
- avant de supprimer le fichier "NouvellePresentation.pps" il faudrait que attendre d'avoir fait "echap" (fin du diaporama) et "clic" (quitter ppt)

Code:

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
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal bla As Long, _
    ByVal ble As String, ByVal bli As String, ByVal lpParameters As String, _
    ByVal blo As String, ByVal blu As Long) As Long
 
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
Dim FichierPpt, pwpt, presppt
 
 
Set PptApp = CreateObject("Powerpoint.Application")
Set PptDoc = PptApp.Presentations.Add(WithWindow:=msoFalse)
 
 
     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 = Sheets("Feuil1").Range.("A1")
 
 ' Ajoute un Slide
          .Slides.Add Index:=2, Layout:=ppLayoutBlank
 'Crée une zone de texte (AddLabe1)
          Set Sh = .Slides(2).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 = Sheets("Feuil2").Range("A1")
 
      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"
          PptDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & "NouvellePresentation.pps"
'ferme la presentation
          PptDoc.Close
'ferme powerpoint
          PptApp.Quit
 
'affichage diaporama
           ShellExecute 0, "open", ThisWorkbook.Path & "\" & "NouvellePresentation.pps", "", "", 3
 
'supprime les présentations[/COLOR]
            Kill (ThisWorkbook.Path & "\" & "NouvellePresentation.ppt")
            Kill (ThisWorkbook.Path & "\" & "NouvellePresentation.pps")
 
 
End Sub

15/08/2014, 17h25
kiki29

Salut, à lire : piloter PowerPoint
15/08/2014, 21h56
clementmarcotte

Bonjour,

Citation:

Envoyé par billard-man

J'ai fais des recherches hier soir et j'ai glané a gauche et a droite des infos.

il me reste quelques problèmes :
- je n'arrive pas a parametrer dans le ppt : le temps d'exposition d'une diapo, la transition (temps et type), le mode defilement automatique, mode boucle.
- avant de supprimer le fichier "NouvellePresentation.pps" il faudrait que attendre d'avoir fait "echap" (fin du diaporama) et "clic" (quitter ppt)

Une fois que tu as ajouté la référence à PowerPoint à partir de l'éditeur VBA d'Excel, tu as facilement accès à l'aide de VBA Powerpoint à partir de l'aide d'Excel. C'est même une caractéristique "universelle" de VBA Office.

Tu peux utiliser la collection Slides() pour itérer tes diapositives et la propriété SlideShowTransition de l'objet Slide() pour appliquer les paramètres de défilement de chaque diapositive.

projet finalisé

merci pour toute votre aide, ci joint la partie de programme comprenant la gestion d'un diaporama ( avec un affichage 16:9 pour un office inferieur a 2010).

Code:

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal bla As Long, _
    ByVal ble As String, ByVal bli As String, ByVal lpParameters As String, _
    ByVal blo As String, ByVal blu As Long) As Long
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
Dim FichierPpt, pwpt, presppt
 
 
Set PptApp = CreateObject("Powerpoint.Application")
Set PptDoc = PptApp.Presentations.Add(WithWindow:=msoFalse)
 
Dim i
Dim var
Dim poule As String
Dim tournoi As String
 
i = 1
 
If (UserForm3.OptionButton1 = True Or UserForm3.OptionButton3 = True) Then
poule = "A"
    While (i < 7)
 
' action
With PptDoc
 
'Ajoute un Slide
    .Slides.Add Index:=i, Layout:=ppLayoutBlank
'Passage en 16/9
    .PageSetup.SlideSize = ppSlideSizeOnScreen16x9
'selection de la plage de cellules dans feuille "A"
     Sheets(poule).Range("A8:AA25").Copy
'insère la plage de Cellules dans une diapo en format image
    PptDoc.Slides(i).Shapes.PasteSpecial (ppPasteBitmap)
    NbShpe = PptDoc.Slides(i).Shapes.Count
    With PptDoc.Slides(i).Shapes(NbShpe)
        .Height = 400 'hauteur image
        .Width = 650 'largeur image
        .Left = 28 'horizontale dans le slide
        .Top = 65 'verticale dans le slide
    End With
 End With
 'paramatrage des effets de transition (vitesse, type,temps exposition)
With PptDoc.Slides(i).SlideShowTransition
    .Speed = ppTransitionSpeedFast
    .EntryEffect = ppEffectStripsDownLeft
    .AdvanceOnTime = True
    .AdvanceTime = 10
End With
    i = i + 1
    poule = Chr(Asc(poule) + 1)
    Wend
End If
If (UserForm3.OptionButton1 = True) Then
' action
poule = "Tours de jeux"
With PptDoc
 
'Ajoute un Slide
    .Slides.Add Index:=i, Layout:=ppLayoutBlank
'Passage en 16/9
    .PageSetup.SlideSize = ppSlideSizeOnScreen16x9
'selection de la plage de cellules dans feuille "A"
     Sheets(poule).Range("A1:N34").Copy
'insère la plage de Cellules dans une diapo en format image
    PptDoc.Slides(i).Shapes.PasteSpecial (ppPasteBitmap)
    NbShpe = PptDoc.Slides(i).Shapes.Count
    With PptDoc.Slides(i).Shapes(NbShpe)
        .Height = 400 'hauteur image
        .Width = 650 'largeur image
        .Left = 35 'horizontale dans le slide
        .Top = 5 'verticale dans le slide
    End With
 End With
 'paramatrage des effets de transition (vitesse, type,temps exposition)
With PptDoc.Slides(i).SlideShowTransition
    .Speed = ppTransitionSpeedFast
    .EntryEffect = ppEffectStripsDownLeft
    .AdvanceOnTime = True
    .AdvanceTime = 10
End With
    i = i + 1
End If
 
 
 
 
If UserForm3.OptionButton3 = True Then
    While (i < 9)
        If i = 7 Then tournoi = "Principal"
        If i = 8 Then tournoi = "Consolante"
 
With PptDoc
'Ajoute un Slide
    .Slides.Add Index:=i, Layout:=ppLayoutBlank
'Passage en 16/9
    .PageSetup.SlideSize = ppSlideSizeOnScreen16x9
'selection de la plage de cellules dans feuille "Principal"
     Sheets(tournoi).Range("A1:Z51").Copy
'insère la plage de Cellules dans une diapo en format image
    PptDoc.Slides(i).Shapes.PasteSpecial (ppPasteBitmap)
    NbShpe = PptDoc.Slides(i).Shapes.Count
    With PptDoc.Slides(i).Shapes(NbShpe)
        .Height = 400 'hauteur image
        .Width = 650 'largeur image
        .Left = 30 'horizontale dans le slide
        .Top = 5 'verticale dans le slide
    End With
 End With
    With PptDoc.Slides(i).SlideShowTransition
    .Speed = ppTransitionSpeedFast
    .EntryEffect = ppEffectStripsDownLeft
    .AdvanceOnTime = True
    .AdvanceTime = 10
    End With
 
    i = i + 1
    Wend
End If
 
If UserForm3.OptionButton2 = True Then
    While (i < 3)
        If i = 1 Then tournoi = "Principal"
        If i = 2 Then tournoi = "Consolante"
 
With PptDoc
'Ajoute un Slide
    .Slides.Add Index:=i, Layout:=ppLayoutBlank
'Passage en 16/9
    .PageSetup.SlideSize = ppSlideSizeOnScreen16x9
'selection de la plage de cellules dans feuille "Principal"
     Sheets(tournoi).Range("A1:Z51").Copy
'insère la plage de Cellules dans une diapo en format image
    PptDoc.Slides(i).Shapes.PasteSpecial (ppPasteBitmap)
    NbShpe = PptDoc.Slides(i).Shapes.Count
    With PptDoc.Slides(i).Shapes(NbShpe)
        .Height = 400 'hauteur image
        .Width = 650 'largeur image
        .Left = 30 'horizontale dans le slide
        .Top = 5 'verticale dans le slide
    End With
 End With
    With PptDoc.Slides(i).SlideShowTransition
    .Speed = ppTransitionSpeedFast
    .EntryEffect = ppEffectStripsDownLeft
    .AdvanceOnTime = True
    .AdvanceTime = 10
    End With
 
    i = i + 1
    Wend
End If
 
If UserForm3.OptionButton2 = True Then
    While (i < 4)
       If i = 3 Then tournoi = "Tours de jeux"
 
With PptDoc
'Ajoute un Slide
    .Slides.Add Index:=i, Layout:=ppLayoutBlank
'Passage en 16/9
    .PageSetup.SlideSize = ppSlideSizeOnScreen16x9
'selection de la plage de cellules dans feuille "Principal"
     Sheets(tournoi).Range("O1:U34").Copy
'insère la plage de Cellules dans une diapo en format image
    PptDoc.Slides(i).Shapes.PasteSpecial (ppPasteBitmap)
    NbShpe = PptDoc.Slides(i).Shapes.Count
    With PptDoc.Slides(i).Shapes(NbShpe)
        .Height = 240 'hauteur image
        .Width = 325 'largeur image
        .Left = 200 'horizontale dans le slide
        .Top = 5 'verticale dans le slide
    End With
 End With
    With PptDoc.Slides(i).SlideShowTransition
    .Speed = ppTransitionSpeedFast
    .EntryEffect = ppEffectStripsDownLeft
    .AdvanceOnTime = True
    .AdvanceTime = 10
    End With
 
    i = i + 1
    Wend
End If
 
    PptDoc.SlideShowSettings.AdvanceMode = _
    ppSlideShowUseSlideTimings
 
 ' En continu jusqu'à echap
With PptDoc.SlideShowSettings
    .LoopUntilStopped = msoTrue
    .AdvanceMode = PowerPoint.PpSlideShowAdvanceMode.ppSlideShowUseSlideTimings
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"
PptDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & "NouvellePresentation.pps"
 
'ferme la presentation
PptDoc.Close
 
'ferme powerpoint
PptApp.Quit
 
'affichage diaporama
 ShellExecute 0, "open", ThisWorkbook.Path & "\" & "NouvellePresentation.pps", "", "", 3
 
'supprime les présentations
Kill (ThisWorkbook.Path & "\" & "NouvellePresentation.ppt")
 
UserForm3.Hide
 
End Sub