Discussion :

[YassDumb]

Bonjour,
J'ai actuellement une macro permettant d'insérer une image dans une zone d'impression définie:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
  ' Aller chercher une image et l'implanter au format A3 paysage
 
               Sheets("Dessin").Select
 
            MsgBox "Vous êtes invité à aller chercher une image du projet"
 
           Dim Emplacement As Range
           Dim Img As Object
           Dim ShapeObj As Shape
 
           'Boucle pour supprimer l'ancienne image
           For Each ShapeObj In ActiveSheet.Shapes
               If ShapeObj.Name = "Cible" Then ActiveSheet.Shapes("Cible").Delete
           Next ShapeObj
 
           If Application.Dialogs(xlDialogInsertPicture).Show Then
               'Définit l'emplacement de l'image
               Set Emplacement = Range("A10:T54")
 
               Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
 
               With Img.ShapeRange
                   'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)
                   .Name = "Cible"
                   .LockAspectRatio = msoFalse
                   .Left = Emplacement.Left
                   .Top = Emplacement.Top
                   .Height = Emplacement.Height
                   .Width = Emplacement.Width
               End With
 
           Else
               MsgBox "Insertion d'image interrompue."
           End If

Est-il possible d'avoir la même chose mais en insérant un PDF?

[kiki29]

Salut, voir Excel / Word / PDF avec Adobe Acrobat Pro et PDFCreator et adapter à ton contexte : il y a une portion de code qui le fait et qui sera à extraire de son contexte PDFCreator ( Post# 24/25 )

PS : une version allégée
Un classeur avec 2 feuilles : Feuil1 et Feuil2
Affecter sur Feuil1 un bouton à SelFichierPDF
Le PDF sera inséré dans Feuil2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
 
Private Sub DeleteAllSheets()
Dim Ws As Worksheet
    For Each Ws In ThisWorkbook.Worksheets
        If Ws.Name <> Feuil1.Name And Ws.Name <> Feuil2.Name Then
            Application.DisplayAlerts = False
            Ws.Delete
            Application.DisplayAlerts = True
        End If
    Next Ws
End Sub
 
Private Sub DelOle()
Dim oOle As OLEObject
    For Each oOle In Worksheets(Feuil2.Name).OLEObjects
        Feuil2.Shapes(oOle.Name).Delete
    Next oOle
End Sub
 
Private Sub InsertionPDF(ByVal sNomFichier As String)
    DeleteAllSheets
    DelOle
    Application.ScreenUpdating = False
    With Feuil2
        .Activate
        .Range("B2").Select
        .OLEObjects.Add Filename:=sNomFichier
    End With
    Application.ScreenUpdating = True
End Sub
 
Sub SelFichierPDF()
Dim Fichier As Variant
    ChDir ThisWorkbook.Path
    Fichier = Application.GetOpenFilename("Fichiers PDF (*.pdf), *.pdf", Title:="Sélection PDF pour Insertion Excel")
    If Fichier = False Then Exit Sub
    DoEvents
    InsertionPDF Fichier
End Sub