[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 :
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
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.
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
Dernière édition: