Macro poour insérer un fichier

[simrobert21]

Bonjour le forum,

Je cherche une macro qui permettrais de faire l'action ci-dessous fait manuellement:

Insertion/Objet/Créer à partir du fichier/ Parcourir
-Il s'agit toujours d'un fichier PDF
-J'aimerais aussi que le fichier soit affiché sous forme d'icône

Dans le fond tout ce qui resterai à choisir à l'utilisateur c'est le fichier PDF à insérer.

J'ai essayé avec l'enregistreur de macro mais il me permet seulement d'insérer toujours le même fichier.

Merci à l'avance

 

[Cousinhub]

Re : Macro poour insérer un fichier

Bonjour

Adapté des pages Wiki de MichelXld

Sub Inserer_Objet_Fichier()
Dim OLEobj As OLEObject
Dim Gauche As Double, HautTop As Double, Largeur As Double, Hauteur As Double
Dim FileToOpen As String
ChDir "C:\Users\bibi\Documents\jphi" 'Répertoire à adapter
FileToOpen = Application.GetOpenFilename("Fichiers Pdf(*.pdf), *.pdf")
If FileToOpen <> "Faux" Then
    Gauche = ActiveCell.Left: HautTop = ActiveCell.Top
    Largeur = ActiveCell.Width * 2: Hauteur = ActiveCell.Height * 3
    Set OLEobj = ActiveSheet.OLEObjects.Add(Filename:=FileToOpen, _
        Link:=False, displayAsIcon:=True, iconIndex:=0, iconLabel:=FileToOpen)
    OLEobj.Left = Gauche: OLEobj.Top = HautTop
    OLEobj.Width = Largeur: OLEobj.Height = Hauteur
End If
End Sub

Bon W-E

 

[simrobert21]

Re : Macro poour insérer un fichier

Bonjour BHBH et le forum

C'est exactement ce que je cherchais... Merci énormément. Petite demande supplémentaire, y aurait-il moyen de mettre le lien vers l'image de l'icône dans le code ? Ainsi au lieu d'un carré blanc, l'icône serait affiché.

Merci à l'avance

 

[simrobert21]

Re : Macro poour insérer un fichier

Vraiment merveilleux, si seulement quelqu'un pouvais me dire comment faire afficher l'îcone pdf.

 

[Cousinhub]

Re : Macro poour insérer un fichier

Bonjour,

Essaie avec ce code (chemin de l'exécutable AcrobatReader à adapter, au niveau d'IconFileName)

Joue également sur la hauteur de l'objet pour améliorer le rendu

Sub Inserer_Objet_Fichier()
Dim OLEobj As OLEObject
Dim Gauche As Double, HautTop As Double, Largeur As Double, Hauteur As Double
Dim FileToOpen As String
ChDir "C:\Users\bibi\Documents\jphi" 'Répertoire à adapter
FileToOpen = Application.GetOpenFilename("Fichiers Pdf(*.pdf), *.pdf")
If FileToOpen <> "Faux" Then
    Gauche = ActiveCell.Left: HautTop = ActiveCell.Top
    Largeur = ActiveCell.Width * 2: Hauteur = ActiveCell.Height * 4
    Set OLEobj = ActiveSheet.OLEObjects.Add(Filename:=FileToOpen, _
        Link:=False, DisplayAsIcon:=True, IconFileName:= _
        "C:\Program Files\Adobe\Reader 8.0\Reader\AcroRd32.exe", IconIndex:=0, IconLabel:=Dir(FileToOpen))
    With OLEobj
        .Left = Gauche: .Top = HautTop
        .Width = Largeur: .Height = Hauteur
    End With
End If
End Sub

Bonne journée

 

[DoubleZero]

Re : Macro poour insérer un fichier

Bonjour et grand merci, bhbh !

 

[simrobert21]

Re : Macro poour insérer un fichier

J'ai été absent au cours des derniers jours. Un grand merci, ça fonctionne parfaitement.