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 |
Partager