Importer Pdf dans Powerpoint

Word, PowerPoint, Outlook, Access et tous les autres logiciels de la suite Office (sauf Excel)
Avatar du membre
Florian53
Membre dévoué
Membre dévoué
Messages : 563
Appréciations reçues : 47
Inscrit le : 3 juin 2015
Version d'Excel : Office 365

Message par Florian53 » 31 octobre 2019, 14:56

Bonjour à tous,

Je suis a la recherche d'une méthode de copie/colle en quelque sorte, pour des fichiers PDF vers PowerPoint.

Objectif : Copier tous les fichiers Pdf présents dans un dossier dans des slides d'un PowerPoint, 1 slide par PDF, sachant que je dois contrôler que le Pdf ne dispose que d'une seule page sinon la macro prends le fichier suivant à fin de faire le même contrôle, si contrôle OK alors copie du PDF, insertion d'une nouvelle slide et du PDF dans celle ci.

J'ai commencé cette macro sur PowerPoint afin de séléctionner le dossier:
Option Explicit
Sub GetFileNames()
    Dim xRow As Long
    Dim xDirect$, xFname$, InitialFoldr$
    
        InitialFoldr$ = "C:\"
        
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Title = "Sélectionner le Dossier contenant les PDF"
            .InitialFileName = InitialFoldr$
            .Show
            
            If .SelectedItems.Count <> 0 Then
                xDirect$ = .SelectedItems(1) & "\"
                xFname$ = Dir(xDirect$ & "*.pdf*")
                Do While xFname$ <> ""
                	'Copie/colle du Pdf dans une nouvelle Slide
                    xFname$ = Dir
                Loop
            End If
            
        End With
        
End Sub

Mais je ne vois pas qu'elle instruction me permettrait soit d’insérer le PDF dans une slide ou de faire un copie/colle ?

Merci à vous.
Les grandes réussites sont le fruit de l'apprentissage durable. Apprenez à apprendre chaque jour.

:btres:
G
GVIALLES
Membre dévoué
Membre dévoué
Messages : 765
Appréciations reçues : 66
Inscrit le : 28 novembre 2017
Version d'Excel : 2016, 360
Téléchargements : Mes applications

Message par GVIALLES » 7 novembre 2019, 11:59

Bonjour Florian,

Je te propose :
Option Explicit
Sub GetFileNames()
    Dim xRow As Long
    Dim xDirect$, xFname$, InitialFoldr$
    Dim oSlide As Slide
    Dim oLayout As CustomLayout
    
        InitialFoldr$ = "C:\"
        
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Title = "Sélectionner le Dossier contenant les PDF"
            .InitialFileName = InitialFoldr$
            .Show
            
            If .SelectedItems.Count <> 0 Then
                xDirect$ = .SelectedItems(1) & "\"
                xFname$ = Dir(xDirect$ & "*.pdf*")
                Set oLayout = ActivePresentation.Slides(1).CustomLayout
                Do While xFname$ <> ""
                    'Copie/colle du Pdf dans une nouvelle Slide
                    Set oSlide = ActivePresentation.Slides.AddSlide(ActivePresentation.Slides.Count + 1, oLayout)
                    oSlide.Shapes.AddOLEObject FileName:=xDirect & "\" & xFname$
                    xFname$ = Dir
                Loop
            End If
            
        End With
        
End Sub
Cordialement,

Gérard
Avatar du membre
Florian53
Membre dévoué
Membre dévoué
Messages : 563
Appréciations reçues : 47
Inscrit le : 3 juin 2015
Version d'Excel : Office 365

Message par Florian53 » 7 novembre 2019, 14:42

Bonjour GVIALLES,

Sa fonctionne nickel, j'ai adapté le code afin que le Pdf soit en pleine slide :
Option Explicit
Sub GetFileNames()
    Dim xRow As Long
    Dim xDirect$, xFname$, InitialFoldr$
    Dim oSlide As Slide
    Dim oLayout As CustomLayout
    
        InitialFoldr$ = "C:\"
        
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Title = "Sélectionner le Dossier contenant les PDF"
            .InitialFileName = InitialFoldr$
            .Show
            
            If .SelectedItems.Count <> 0 Then
                xDirect$ = .SelectedItems(1) & "\"
                xFname$ = Dir(xDirect$ & "*.pdf*")
                Set oLayout = ActivePresentation.Slides(1).CustomLayout
                Do While xFname$ <> ""
                    'Copie/colle du Pdf dans une nouvelle Slide
                    Set oSlide = ActivePresentation.Slides.AddSlide(ActivePresentation.Slides.Count + 1, oLayout)
                    oSlide.Shapes.AddOLEObject Left:=0, Top:=0, Width:=oLayout.Width, Height:=oLayout.Height, FileName:=xDirect & "\" & xFname$
    
                    xFname$ = Dir
                Loop
            End If
            
        End With
        
End Sub
Le problème que je rencontre mais je nais pas si on peut faire quelque chose à celui ci, est la qualité du PDF importer dans le PWT. La qualité du PDF d'origine est très impactée lors de son importation dans PowerPoint, est ce qu'il aurait une méthode afin de ne pas perdre en qualité ?

Encore merci de votre aide. :mrgreen:
Les grandes réussites sont le fruit de l'apprentissage durable. Apprenez à apprendre chaque jour.

:btres:
G
GVIALLES
Membre dévoué
Membre dévoué
Messages : 765
Appréciations reçues : 66
Inscrit le : 28 novembre 2017
Version d'Excel : 2016, 360
Téléchargements : Mes applications

Message par GVIALLES » 8 novembre 2019, 10:05

Bonjour Florian,

Une idée qui vaut ce qu'elle vaut (je ne connais pas la nature de tes PDF) : d'abord transformer les PDF en JPEG puis copier les images dans Powerpoint...
Option Explicit
Sub GetFileNames()
    Dim xRow As Long
    Dim xDirect$, xFname$, InitialFoldr$
    Dim oSlide As Slide
    Dim oLayout As CustomLayout
    
        InitialFoldr$ = "C:\"
        
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Title = "Sélectionner le Dossier contenant les PDF"
            .InitialFileName = InitialFoldr$
            .Show
            
            If .SelectedItems.Count <> 0 Then
                xDirect$ = .SelectedItems(1) & "\"
                xFname$ = Dir(xDirect$ & "*.jpg*")
                Set oLayout = ActivePresentation.Slides(1).CustomLayout
                Do While xFname$ <> ""
                    'Copie/colle du Pdf dans une nouvelle Slide
                    Set oSlide = ActivePresentation.Slides.AddSlide(ActivePresentation.Slides.Count + 1, oLayout)
                    'oSlide.Shapes.AddOLEObject Left:=0, Top:=0, Width:=oLayout.Width, Height:=oLayout.Height, FileName:=xDirect & "\" & xFname$
                    oSlide.Shapes.AddPicture xDirect & "\" & xFname$, msoFalse, msoTrue, 0, 0
                    xFname$ = Dir
                Loop
            End If
            
        End With
        
End Sub
Cordialement,

Gérard
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message