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
| 'Avant toute chose tu dois ajouter des bibliothèques. Dans VBE > Outils > Références coche Microsoft PowerPoint x.x Object Library et Microsoft Scripting Runtime.
Sub pptx()
'Déclaration des variables
Dim Dossier As Object, Fichier As Object
Dim chemin As String
Dim y As Integer, nb As Integer
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
'Initialisation de certaines variables
chemin = ThisWorkbook.Path
y = 1
nb = 0
'Nettoyage de l'onglet TABLEAU PPT
Worksheets("TABLEAU PPT").Cells.Delete
'Suppression des anciens ALL.pptx et ALL.pdf
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(chemin)
For Each Fichier In Dossier.Files
If Fichier.Name = "ALL.pptx" Or Fichier.Name = "ALL.pdf" Then
Kill chemin & "\" & Fichier.Name
End If
Next Fichier
'Récupération des fichiers pptx et inscription dans le tableau
For Each Fichier In Dossier.Files
If Right(Fichier.Name, 5) = ".pptx" Then
Worksheets("TABLEAU PPT").Cells(y, 1).Value = Fichier.Name
y = y + 1
nb = nb + 1
End If
Next Fichier
'Triage par ordre alphabétique
Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending
'Création du powerpoint global
Set PptApp = CreateObject("Powerpoint.Application")
Set PptDoc = PptApp.Presentations.Add
'Copie des différentes présentations dans la présentation globale
For y = 1 To nb
PageCount = PptApp.ActivePresentation.Slides.Count
PptDoc.Slides.InsertFromFile ActiveWorkbook.Path & "\" & Worksheets("TABLEAU PPT").Cells(y, 1).Value, PageCount, 1, 1
Next y
'Sauvegarde de la présentation globale, le nom du fichier (ici ALL.pptx) est a modifier pour te convenir
PptDoc.SaveAs Filename:=chemin & "\" & "ALL.pptx"
'Calcul du nombre de diapo dans la présentation globale
tsh = PptDoc.Slides.Count
'Conversion de la présentation globale en .pdf
ActivePresentation.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=chemin & "\" & "ALL.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=True, _
OpenAfterPublish:=False
'Fermeture de la présentation
PptDoc.Close
'Fermeture de l'application
PptApp.Quit
'Intégration des statistiques dans l'onglet RESULTATS
With Worksheets("RESULTATS")
.Rows(1).Resize(4).Insert
.Cells(1, 1).Value = Now
.Cells(3, 2).Value = "Nombre de dispositive :"
.Cells(3, 3).Value = tsh
.Cells.EntireColumn.autofit
End With
End Sub |
