Lancer une macro powerpoint depuis EXCEL
Résolu
pygos
Messages postés
202
Statut
Membre
-
f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention -
f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
Je souhaite lancer à partir d'Excel une macro powerpoint (Merci à M@rina) :
Voici la macro que je lance habituellement depuis Powerpoint :
Option Explicit
Public Sub conversion_pptx()
'macro écrite par m@rina
'convertit des fichiers pps en fichiers pptx
'et supprime les fichiers pps
Dim vFichier As Variant
Dim NbFichOK As Integer
Dim Nom As String
' Sélection des fichiers
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = True
.Title = "Sélectionner les fichiers à traiter"
.Filters.Add "Diaporamas 2003", "*.pps"
If .Show <> -1 Then Exit Sub
'If MsgBox(.SelectedItems.Count & " fichiers à traiter ", vbOKCancel, _<br> "continuer ?") = vbCancel Then Exit Sub
End With
' ouverture du fichier
For Each vFichier In fd.SelectedItems
On Error GoTo Suivant
Application.Presentations.Open vFichier
On Error GoTo Fermer
NbFichOK = NbFichOK + 1
'nouveau nom
Nom = Left(vFichier, Len(vFichier) - 4) & ".pptx"
'enregistre au format pptx et ferme
Presentations(vFichier).SaveAs FileName:=Nom
Presentations(Nom).Close
Fermer:
On Error GoTo Suivant
Suivant:
On Error GoTo 0
Kill vFichier
Next vFichier
'fin
MsgBox ("Fichiers convertis : " & NbFichOK & " Fichiers")
Set fd = Nothing
End Sub
Merci d'avance,
Je souhaite lancer à partir d'Excel une macro powerpoint (Merci à M@rina) :
Voici la macro que je lance habituellement depuis Powerpoint :
Option Explicit
Public Sub conversion_pptx()
'macro écrite par m@rina
'convertit des fichiers pps en fichiers pptx
'et supprime les fichiers pps
Dim vFichier As Variant
Dim NbFichOK As Integer
Dim Nom As String
' Sélection des fichiers
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = True
.Title = "Sélectionner les fichiers à traiter"
.Filters.Add "Diaporamas 2003", "*.pps"
If .Show <> -1 Then Exit Sub
'If MsgBox(.SelectedItems.Count & " fichiers à traiter ", vbOKCancel, _<br> "continuer ?") = vbCancel Then Exit Sub
End With
' ouverture du fichier
For Each vFichier In fd.SelectedItems
On Error GoTo Suivant
Application.Presentations.Open vFichier
On Error GoTo Fermer
NbFichOK = NbFichOK + 1
'nouveau nom
Nom = Left(vFichier, Len(vFichier) - 4) & ".pptx"
'enregistre au format pptx et ferme
Presentations(vFichier).SaveAs FileName:=Nom
Presentations(Nom).Close
Fermer:
On Error GoTo Suivant
Suivant:
On Error GoTo 0
Kill vFichier
Next vFichier
'fin
MsgBox ("Fichiers convertis : " & NbFichOK & " Fichiers")
Set fd = Nothing
End Sub
Merci d'avance,