XL 2016 Adapter une image à une cellule

[Alyogali]

[Edit complet de mon post d'origine]

Bonjour tout le monde,

Mon dernier projet en date (et donc celui qui me pose problème et qui m'a conduit jusqu'à ce forum) c'est de créer des fiches pour mes jeux de société.
J'aurais pu faire une base de données access ou un publipostage sous word mais pour de sombres et obscures raisons j'ai fait ça sous excel.

Je vais essayer d'expliquer tout ça le plus simplement et clairement possible...

J'ai deux feuilles excel :

• une première feuille qui regroupe la liste des jeux avec les informations (nombre de joueurs, durée, mécanique, blablabla)
• et une seconde feuille excel j'ai fait une mise en page pour chaque jeu.

Avec une fonction recherche j'arrive à bien importer toutes mes données : je tape le nom du jeu comme nom de feuille excel et ensuite ça rempli automatiquement toutes les informations sur la page.
Là où je sèche, c'est pour importer les images (une image de la boite et une image du matériel).

L'idée souhaitée c'est que quand je modifie le nom de l'onglet, toute la page s'actualise pour le jeu correspondant. Donc les valeurs (ça c'est bon, je sais faire) mais aussi que la photo du jeu s'affiche dans la cellule (cellules fusionnées) correspondante en s'ajustant à la cellule (centrée et ajustée à la hauteur et ou largeur de la cellule).

J'ai trouvé un code VBA qui fait bien le boulot sur un site que j'ai vu très souvent conseillé sur les forums.
http://boisgontierj.free.fr/pages_site/lesimages.htm#FonctionAffiche

Sauf que l'image rempli toute la cellule.
Je souhaiterais que l'image s'adapte à la hauteur de la cellule et se centre dans la largeur.

Sur ce même site il y a d'autres codes qui devraient pouvoir faire ça mais je n'y connais rien en VBA et aucun ne fonctionne.

Est-ce que quelqu'un pourrait m'aider à adapter le code suivant pour adapter l'image à la cellule ?
Merci d'avance.

Function AfficheImage(NomImage, Optional rep As String)
Application.Volatile
If IsMissing(rep) Then rep = ThisWorkbook.Path & "\"
Set f = Sheets(Application.Caller.Parent.Name)
Set adr = Application.Caller
Set adr2 = Range(adr.Address).MergeArea
temp = NomImage & "_" & adr.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
If Mid(k.Name, InStr(k.Name, "_") + 1) = adr.Address Then k.Delete
Next k
f.Shapes.AddPicture(rep & NomImage, True, True, adr.Left, adr.Top, adr2.Width, adr2.Height).Name = NomImage & "_" & adr.Address
End If
End Function

 

[Alyogali]

Mais évidemment si tu ne connais RIEN au VBA, c'est comme essayer de piloter un avion sans avoir été formé.

Tout à fait. Dans l'idée.
Sauf qu'avec le VBA, si je me plante, le pire qui puisse arriver c'est que ça ne marche pas.
Alors qu'avec l'avion les conséquences peuvent être un peu plus lourdes...

 

[Dudu2]

Alors qu'avec l'avion les conséquences peuvent être un peu plus lourdes...

Oui, encore faut-il déjà arriver à décoller