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
|
Sub M_OUVERTURE_FIC_PPT()
' Déclaration des variables
Dim Nom_Fic_Macro As String
Dim Path_Fic_Macro As String
Dim TitreMsg As String
Dim PPT_App As Object
Dim PPT_Doc As Object
Dim PPT_Doc_ouvert As Object
Dim Path_Fic_PPT As Variant
Dim Cpt_bs As Integer
' Initialisation de l'écran, non-affichage des alertes et non-demande de mise à jour des liaisons (pour Excel)
Application.ScreenUpdating = True
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
' Acquisition du nom et du chemin d'accès du fichier Excel où est présente la macro
Nom_Fic_Macro = ThisWorkbook.Name
Path_Fic_Macro = ThisWorkbook.Path
' Attribution du titre des messages affichés
TitreMsg = Left(Nom_Fic_Macro, Len(Nom_Fic_Macro) - 4)
' Sélection du fichier PowerPoint qui contient les objets liés
' Si aucun fichier n'est sélectionné, la macro est quittée
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Sélectionnez le fichier PowerPoint contenant les objets liés"
.InitialFileName = Path_Fic_Macro
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Fichiers PowerPoint (*.ppt)", "*.ppt"
.InitialView = msoFileDialogViewDetails
.ButtonName = "Sélectionner"
.Show
If .SelectedItems.Count = 0 Then
Exit Sub
Else
Path_Fic_PPT = .SelectedItems(1)
For Cpt_bs = Len(Path_Fic_PPT) To 1 Step -1
If Mid(Path_Fic_PPT, Cpt_bs, 1) = "\" Then
Nom_Fic_PPT = Right(Path_Fic_PPT, Len(Path_Fic_PPT) - Cpt_bs)
Exit For
End If
Next Cpt_bs
End If
End With
' Création de l'objet PowerPoint, objet invisible, et non-affichage des alertes dans PowerPoint
' PPT_App.DisplayAlerts = 1 -> 1 = valeur de ppAlertsNone (argument propre à Powerpoint)
Set PPT_App = CreateObject("PowerPoint.Application")
PPT_App.DisplayAlerts = 1
' Si le fichier PowerPoint défini par l'utilisateur est ouvert,
' il est fermé par la macro, avec une demande de sauvegarde
For Each PPT_Doc_ouvert In PPT_App.Presentations
If PPT_Doc_ouvert.FullName = Path_Fic_PPT Then
If MsgBox("Le fichier PowerPoint que vous avez sélectionnez est déjà ouvert." & Chr(10) & _
"Il va être fermé." & Chr(10) & Chr(10) & _
"Souhaitez-vous l'enregistrer ?", vbYesNo + vbQuestion, TitreMsg) = vbYes Then
PPT_Doc_ouvert.Save
End If
PPT_Doc_ouvert.Close
End If
Next PPT_Doc_ouvert
' Ouverture du fichier PowerPoint sans afficher la fenêtre PowerPoint
Set PPT_Doc = PPT_App.Presentations.Open(Path_Fic_PPT, WithWindow:=msoFalse)
' Initialisation de l'écran, affichage des alertes et demande de mise à jour des liaisons (pour Excel)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
End Sub |
Partager