Tu sais je ne passe pas mon temps à compresser des images alors j'en ai rien à cirerJamais eu de soucis avec Pixillion?
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
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
Bonsoir JOB 75,Re,
Ceci est mieux car on conserve le ratio largeur/hauteur de l'image d'origine :
Fichier (2).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
A+
Bonsoir et merci pour le travail mais ça ne fonctionne pas ... les images n'apparaissent pas dans l'exemple ?Bonjour,
Avec images externes pour éviter classeur volumineux.
Bisson
Bonsoir,
Une proposition avec un clic sur image pour zoomer + reclic pour diminuer
Slts
rebonjour,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ù