Syntaxerror
XLDnaute Junior
Récupérer les dimensions d'un fichier image
Salut le forum !
Après avoir écrit un code qui insère une image récupérer par une boite de dialogue getopenfile dans un commentaire (c'est moi qui l'ai fait ! )
Je m'aperçoit qu'en fonction des dimensions de l'image, celle ci est souvent écrasée. Je voudrais récupérer les dimension de l'image du fichier afin de redimentionner la bulle de mon commentaire. Voici ma macro:
Après un longue recherche j'ai trouvé dans le forum ce morceau de code :
Mais je ne parviens pas à l'appliquer à ma macro (snif !). Si quelqu'un pouvait m'aider à l'intégrer ou avec un autre ID....
Merci d'avance
Salut le forum !
Après avoir écrit un code qui insère une image récupérer par une boite de dialogue getopenfile dans un commentaire (c'est moi qui l'ai fait ! )
Je m'aperçoit qu'en fonction des dimensions de l'image, celle ci est souvent écrasée. Je voudrais récupérer les dimension de l'image du fichier afin de redimentionner la bulle de mon commentaire. Voici ma macro:
Code:
Sub bullimage()
'
'
' Macro enregistrée le 24/02/2009 par Christophe
'
ActiveCell.AddComment
ActiveCell.Comment.Visible = False
ActiveCell.Comment.Text Text:=""
ActiveCell.Comment.Shape.Fill.ForeColor.RGB = RGB(255, 255, 255)
ActiveCell.Comment.Shape.Fill.BackColor.RGB = RGB(255, 255, 255)
ChDir ("G:\_Chemdraw")
CheminFichier = Application.GetOpenFilename(FileFilter:="Fichiers Image (*.jpg;*.gif), *.jpg;*.gif ", Title:="Fichier jpg")
'Arrêt de la procédure si on clique sur Annuler
If Trim(CheminFichier) = "Faux" Then Exit Sub
'taille = TaillePixelsImage(CheminFichier, Trim(CheminFichier))
ActiveCell.Comment.Shape.Fill.UserPicture (CheminFichier)
ActiveCell.Comment.Shape.LockAspectRatio = msoFalse
ActiveCell.Hyperlinks.Add anchor:=ActiveCell, Address:=CheminFichier, TextToDisplay:=ActiveCell.Value
ActiveCell.Offset(-1, 0).Copy
ActiveCell.PasteSpecial (xlPasteFormats)
End Sub
Code:
Function TaillePixelsImage(repertoire, fichier)
Set myShell = CreateObject("Shell.Application")
Set myFolder = myShell.Namespace(repertoire)
Set myFile = myFolder.Items.Item(fichier)
TaillePixelsImage = myFolder.GetDetailsOf(myFile, 26)
End Function
Mais je ne parviens pas à l'appliquer à ma macro (snif !). Si quelqu'un pouvait m'aider à l'intégrer ou avec un autre ID....
Merci d'avance
Dernière édition: