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 ' NON-AFFICHAGE DU MESSAGE DE DEMANDE DE MAJ DES LIAISONS
' 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