RESOLU: Agrandir et réduire une image

[maxousurf]

Bonjour à tous !

J'ai longtemps parcouru la toile pour tenter de trouver une réponse à ma question.

En effet, j'ai une macro qui me permet, lorsque je clique sur une sélection de cellules, de choisir une image et cette dernière est automatiquement redimensionnée à la taille de sélection.

Ce que j'aimerai, c'est rajouter une macro pour pouvoir faire en sorte que lorsque je clique sur l'image précédemment insérée, elle s'agrandisse et lorsque je re-clique dessus, elle se remet à la taille initiale.

J'ai trouvé des morceaux de macro sur internet mais je ne parviens pas à faire ce que je veux.

Quelqu'un aurait-il une solution à mon problème ?

Je vous mets le fichier en pièce-jointe, les deux macros sont dans le Module 2.

Bonne journée

 

[MJ13]

Re : Agrandir et réduire une image

Bonjour à tous

Tout à fait, je comprends ce que tu veux dire, mais pourquoi je n'ai pas le même résultat ?

En général, les gens envoie plutôt leur fichier plutôt qu'une image .

 

[maxousurf]

Re : Agrandir et réduire une image

MJ13, je n'ai pas envoyé le fichier puisqu'il y est déjà, j'ai pris le fichier "Copie de Agrandir image" et je n'ai rien touché au niveau du code, du coup ça ne sert pas qu'il y soit deux fois

Alors en rajoutant ton code, voila ce que j'obtiens:
posCellule gauche = 298,5 poscelulle haut = 60
posimage gauche = 50 posimage haut = 50

 

[sousou]

Re : Agrandir et réduire une image

Bonjour maxousurf
OK, il y à donc bien un problême.
Dans ce que je t'ai envoyé, je ne déterminai pas précisément la position left et top de l'image.
Sur mon Excel, l'insertion pictures.insert la positionnait naturellement sur la cellule active.
J'ai donc ajouté dans la version jointe le positionnement left, top et en ai profité pour effectuer le centrage.

 

[MJ13]

Re : Agrandir et réduire une image

Bonjour à tous

Voici un code sur XL2013, qui permet d'adapter l'image à la cellule. A tester sur les anciennes versions.

Sub Ins_Img()
FicImg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image") ' choix nom du fichier
    If FicImg = "Faux" Then Exit Sub
ActiveSheet.Pictures.Insert( _
        FicImg).Select
        Selection.Height = ActiveCell.Height
End Sub
Sub Rétabli_Image_Original()
Selection.ShapeRange.ScaleHeight 1, msoTrue, msoScaleFromTopLeft
End Sub
Sub Rétabli_Image_Cellule()
Selection.Height = ActiveCell.Height
End Sub

 

[maxousurf]

Re : Agrandir et réduire une image

Sousou, j'obtiens exactement le résultat attendu !
Merci aussi pour ton code, MJ13

Merci à tous pour votre aide, je place ce topic en "RESOLU", bonne journée et merci encore !