agrandit une image au passage de la souris

Grégf

XLDnaute Junior
Bonjour,
je souhaite qu'une image s'agrandisse quand je passe la souris dessus.
Je joints un fichier pour que ce soit plus parlant.
Merci, cordialement.
 

Pièces jointes

  • JFK.xlsx
    55.5 KB · Affichages: 92

job75

XLDnaute Barbatruc
Bonjour Grégf, le fil, le forum,

Le survol de la souris est une excellente méthode si l'on utilise des commentaires.

Pas besoin de VBA, chaque commentaire peut être créé manuellement en chargeant le fichier JPEG dans les motifs de la couleur du remplissage.

Mais pour plus de facilité on lancera cette macro :
Code:
Sub Commentaires()
Dim c As Rangex
[C:C].ClearComments
For Each c In [A:A].SpecialCells(xlCellTypeConstants, 1)
  c(1, 3).AddComment
  With c(1, 3).Comment.Shape
    .Visible = False
    .Width = 87 'à adapter
    .Height = 135 'à adapter
    .Fill.UserPicture ActiveWorkbook.Path & "\" & c & ".jpg"
  End With
Next
End Sub
Tous les fichiers doivent être dans le même répertoire, sinon adapter le chemin d'accès.

Fichier .xlsx (sans macros) joint, il ne pèse pas lourd.

Bonne journée.
 

Pièces jointes

  • JFK sans VBA(1).xlsx
    241 KB · Affichages: 73

job75

XLDnaute Barbatruc
Re,

Ceci est mieux car on conserve le ratio largeur/hauteur de l'image d'origine :
Code:
Sub Commentaires()
Dim c As Range, chemin$, im As Object, r#
Application.ScreenUpdating = False
[C:C].ClearComments
For Each c In [A:A].SpecialCells(xlCellTypeConstants, 1)
  chemin = ActiveWorkbook.Path & "\" & c & ".jpg"
  Set im = LoadPicture(chemin)
  r = im.Width / im.Height 'ratio
  c(1, 3).AddComment
  With c(1, 3).Comment.Shape
    .Visible = False
    .Height = 135 'à adapter
    .Width = r * .Height
    .Fill.UserPicture chemin
  End With
Next
End Sub
Fichier (2).

A+
 

Pièces jointes

  • JFK sans VBA(2).xlsx
    241.2 KB · Affichages: 72
Dernière édition:

Grégf

XLDnaute Junior
Re,

Ceci est mieux car on conserve le ratio largeur/hauteur de l'image d'origine :
Code:
Sub Commentaires()
Dim c As Range, chemin$, im As Object, r#
Application.ScreenUpdating = False
[C:C].ClearComments
For Each c In [A:A].SpecialCells(xlCellTypeConstants, 1)
  chemin = ActiveWorkbook.Path & "\" & c & ".jpg"
  Set im = LoadPicture(chemin)
  r = im.Width / im.Height 'ratio
  c(1, 3).AddComment
  With c(1, 3).Comment.Shape
    .Visible = False
    .Height = 135 'à adapter
    .Width = r * .Height
    .Fill.UserPicture chemin
  End With
Next
End Sub
Fichier (2).

A+
Bonsoir JOB 75,
Merci pour les explications détaillées (mon tout petit niveau fait que j'en avais vraiment besoin !).
Du coup mon coeur balance et il va falloir que je fasse mon choix.
Encore mille fois merci pour tout ce travail et bonne soirée.
 

derk

XLDnaute Nouveau
Bonsoir,

Une proposition avec un clic sur image pour zoomer + reclic pour diminuer

Slts

bonsoir riton00, je sais que ma question vient 3ans apres tonposte mais je desespere un peu
ton code est juste parfait par contre est ce qu'il y a oen de faire en sorte que :
1 le code ne s'applique qu'aux images et pas aux boutons (controle de formulaire) ?
2 quand on clique sur l'image pour l'agandir, est ce que cette dernière peut s'afficher au centre de l'ecran ?et pas à partir du TopLeftCell
je joins ton fichier posté en 2017 &u cas où :)
 

Pièces jointes

  • zoom sur clic image (1).xlsm
    62.2 KB · Affichages: 10

derk

XLDnaute Nouveau
bonsoir riton00, je sais que ma question vient 3ans apres tonposte mais je desespere un peu
ton code est juste parfait par contre est ce qu'il y a oen de faire en sorte que :
1 le code ne s'applique qu'aux images et pas aux boutons (controle de formulaire) ?
2 quand on clique sur l'image pour l'agandir, est ce que cette dernière peut s'afficher au centre de l'ecran ?et pas à partir du TopLeftCell
je joins ton fichier posté en 2017 &u cas où :)
rebonjour,
j'au pu solutionné la 1ere problématique
maintenant je tourne en rond pour la 2nd : quand on clique sur l'image pour l'agrandir, est ce que cette dernière peut s'afficher au centre de l'écran ?
 

Discussions similaires

Réponses
14
Affichages
320

Statistiques des forums

Discussions
314 629
Messages
2 111 345
Membres
111 110
dernier inscrit
chergui