Macro pour agrandir image

Résolu
paola -  
 Paola335 -
Bonjour,

Je travaille sur un fichier Excel 2010, avec environ 200 images, une sur chaque ligne (colonne E), pour expliciter le lieu que j'indique dans ces lignes.
Ces images sont assez petites et peu visibles.

J'aimerai que, si une personne veut voir cette image en plus grand, elle ait juste à cliquer sur l'image pour que celle-ci s'agrandisse, puis à cliquer une seconde fois pour la réduire.

J'ai cherché une solution sur différents forums, et je suis parvenue à la conclusion qu'il me fallait faire une macro pour avoir ce résultat.

Quelqu'un saurait-il comment la construire ?
Je travaille sur plusieurs feuilles, avec à chaque fois le même modèle de tableau, est-ce que c'est gênant ?


Merci d'avance,

Paola
A voir également:

6 réponses

pilas31 Messages postés 1825 Date d'inscription   Statut Contributeur Dernière intervention   646
 
Bonjour,

C'est un problème intéressant. J'ai cherché une solution simple.
L'idée c'est d'associer une macro à chaque image.
Lorsqu'on clique, la macro double la taille de l'image et associe une autre macro de sorte que quand on reclique elle divise par 2 la taille de l'image et ré-associe la macro initiale.
Au début il faut initialiser afin que toutes les images aient la macro associée dés le départ.
D'où le code des trois macros !
Private Sub Agrandir_image()
    ActiveSheet.Shapes.Range(Array(Application.Caller)).Select
    Selection.ShapeRange.ScaleHeight 2, msoFalse
    Selection.ShapeRange.ScaleWidth 2, msoFalse
    Selection.OnAction = "Diminuer_image"
    ActiveSheet.Shapes(Application.Caller).TopLeftCell.Select
End Sub
Private Sub Diminuer_image()
    ActiveSheet.Shapes.Range(Array(Application.Caller)).Select
    Selection.ShapeRange.ScaleHeight 0.5, msoFalse
    Selection.ShapeRange.ScaleWidth 0.5, msoFalse
    Selection.OnAction = "Agrandir_image"
End Sub
Sub initialiser()
    For Each Image In ActiveSheet.Shapes
       Image.OnAction = "Agrandir_image"
    Next Image
End Sub

Il faut copier ces trois macros dans un module vba.
ALt+ F11 on va dans l'éditeur vba puis insérer module et copier le code ci-dessus.
Puis il faut lancer la macro "initialiser" dans la feuille.
Alt+F8 choisir et exécuter la macro "initialiser"


Voila. A tester et merci du retour pour éventuelles améliorations.
Par exemple lancer initialiser sur toutes les feuilles à l'ouverture du classeur.
5
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
Bonjour Paola
Bonjour Pilas, ca va ?) :o)
une alternative
la photo est agrandie par survol de la colonne C
https://www.cjoint.com/?3DzoTRtU77f

mais je fourgonne ta solution, Pilas! @+
Michel
1
pilas31 Messages postés 1825 Date d'inscription   Statut Contributeur Dernière intervention   646
 
Bonjour Paola
Et bonjour Michel.

Oui je sais d'où vient l'erreur, j'ai été un peu simpliste !
Si dans le fichier il y a des boutons ou d'autre type de formes que des images, cela ne marche pas. D'où une nouvelle mouture, on teste que ce ne sont que les images auxquelles on associe la macro :

Private Sub Agrandir_image()
    ActiveSheet.Shapes.Range(Array(Application.Caller)).Select
    Selection.ShapeRange.ScaleHeight 2, msoFalse
    Selection.ShapeRange.ScaleWidth 2, msoFalse
    Selection.ShapeRange.ZOrder msoBringToFront
    Selection.OnAction = "Diminuer_image"
    ActiveSheet.Shapes(Application.Caller).TopLeftCell.Select
End Sub
Private Sub Diminuer_image()
    ActiveSheet.Shapes.Range(Array(Application.Caller)).Select
    Selection.ShapeRange.ScaleHeight 0.5, msoFalse
    Selection.ShapeRange.ScaleWidth 0.5, msoFalse
    Selection.ShapeRange.ZOrder msoSendToBack
    Selection.OnAction = "Agrandir_image"
End Sub
Sub initialiser()
    For Each Image In ActiveSheet.Shapes
    If Image.Type = msoPicture Or Image.Type = msoLinkedPicture Then
       Image.OnAction = "Agrandir_image"
    End If
    Next Image
End Sub


De plus je mets au premier plan l'image agrandie et en arrière l'image rétrécie.

Voilà.

La solution de Michel est particulièrement élégante (je suis même jaloux !).
1
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
je suis même jaloux !
Salut Pilas !
Meuuhnon !
D'ailleurs, il y a des photos qui doivent peut-^tre te dire quelque chose! ;o)
(y'a un très non restau pas cher aux Salleles vallée de l'Ibie!)
0
pilas31 Messages postés 1825 Date d'inscription   Statut Contributeur Dernière intervention   646 > michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention  
 
Oui je connais pas mal de ces endroits !! mais j'ai beaucoup moins l'occasion d'y aller hélas !
0
Paola
 
Bonjour, et merci beaucoup !

Je me cassais la tête dessus depuis des jours, et quand on voit le code bien écrit ça a l'air tout simple ^^

J'ai testé sur mon fichier, et ça marche parfaitement !
Juste quand la macro s'exécute une partie de l'image agrandie est parfois masquée par l'image de la ligne en dessous, mais il suffit que je mette toutes mes images en arrière plan et ce sera résolu :)

Pourquoi faudrait-il lancer initialiser sur toutes les feuilles à l'ouverture du classeur ?
J'ai fermé le document et quand je l'ouvre a nouveau la macro est toujours active sur les images.

Merci beaucoup en tout cas, c'est exactement ce que j'avais en tête ! :D
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Paola335 Messages postés 1 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour,

Ce matin je suis retournée au travail, et j'ai voulu appliquer la macro à mon fichier, mais ça ne fonctionne pas, Excel me dit qu'il y a un problème à la ligne Image.OnAction = "Agrandir_image".

Je suis un peu étonnée, parce que quand j'ai essayé chez moi ce week end la macro se déroulait bien.

Cela pourrait-il venir du fait que chez moi j'ai Excel 2013 et ici Excel 2010 ?

Je ne vois pas d'autres choses qui ont changé.

Merci d'avance,

Paola
0
Paola335
 
Bonjour Pilas et Michel,

La modification de macro marche très bien :)
Et le fait que l'image soit directement en avant est appréciable !

Merci beaucoup pour l'aide apportée, il ne me reste plus qu'à me mettre moi même aux macros ^^

Bonne continuation,

Paola
0

Discussions similaires