VBA Insertion Image dans cellule fusionnée à partir d'un lien Hypertexte

[preysgnouf]

Bonjour,

Je souhaite créer une fiche de site à partir du listing de sites. Le listing est situé dans la "feuille 1" et la fiche dans la "feuille 2".
Lorsque l'on appelle en "D1" le code du site, l'ensemble du tableau se complète.

Je souhaite afficher la photo (issue du lien hypertexte) dans les cellules fusionnées A19:Y19, mais je dois avoir un problème de code. Je n'ai pas de connaissance en VBA, ma macro est donc issue de copier coller de forums.

La photo doit prendre la hauteur ou la largeur de la cellule et respecter les proportions.

Je vous remercie d'avance

 

[preysgnouf]

Re : VBA Insertion Image dans cellule fusionnée à partir d'un lien Hypertexte

Bonjour

La macro est copié du boisgontierjacques. Sur son site il expose deux solutions que je n arrive pas a assembler

Preysgnouf

 

[preysgnouf]

Re : VBA Insertion Image dans cellule fusionnée à partir d'un lien Hypertexte

bonjour,

Voici le code. Pouvez vous me dire ou se trouve l'érreur (ou les érreurs)

Function AfficheImage(NomImage As Range)
Application.Volatile
Set f = Sheets(Application.Caller.Parent.Name)
Set adr = Range(NomImage.Address)
temp = NomImage & "_" & NomImage.Address
Existe = False
For Each s In adr.Worksheet.Shapes
If s.Name = temp Then Existe = True
Next s
If Not Existe Then
For Each k In adr.Worksheet.Shapes
P = InStr(k.Name, "_")
If Mid(k.Name, P + 1) = adr.Address Then k.Delete
Next k
Set s = f.Shapes.AddPicture(NomImage, True, True, adr.Left, adr.Top, adr.Width, adr.Height - 8)
s.Name = NomImage & "_" & NomImage.Address
'Vous insèrez en A19:Y19'
Set Pos = Range("A19:Y19")
Set Pict = ActiveSheet.Shapes(1)
With Pict
'Vous conservez les proportions de l'image
.LockAspectRatio = msoTrue
'Vous positionnez l'image sur la sélection
.Left = Pos.Left
.Top = Pos.Top
'Vous adaptez la hauteur de l'image à la sélection
.Height = Pos.Height
.Width = Pos.Width
End With
End If
End Function

Merci d'avance
Preysgnouf