bonjour tout le monde,
j'ai enfin réussi a faire ce que je voulais voila la source
Il y a qques modification que j'ai effectuer...
Sub ajoutImageCommentaire()
Dim Repertoire As String
Dim Rep As Variant
Dim C As Range
With Sheets("Appareils" )
On Error Resume Next
For Each C In Range("F1:F" & Range("F65536" ).End(xlUp).Row)
Repertoire = ActiveWorkbook.Path & "\Photos\" & Trim(C.Value) & ".jpg"
If Dir(Repertoire) <> "" Then
If Not C = "" Then
With C.Offset(0, -1)
.AddComment
.Comment.Shape.Fill.UserPicture Repertoire
.Comment.Visible = False 'Masque le commentaire
End With
Rep = ActiveWorkbook.Path & "\Photos\"
With C.Offset(0, -1).Comment.Shape
.Width = Val(dimensionsImage(Rep, Trim(C.Value) & ".jpg", 27))
.Height = Val(dimensionsImage(Rep, Trim(C.Value) & ".jpg", 28))
'les index 27 et 28 de la methode GetDetailsOf ,
'permettent de recuperer les dimensions de l'image...
'bien qu'ils soient indiqués comme "Not Used" dans l'aide Microsoft...
End With
End If
End If
Next
End With
End Sub
Public Function dimensionsImage(Chemin As Variant, nomImage As Variant, Itm As Integer)
Dim objShell As Object, strFileName As Object
Dim objFolder As Object
Set objShell = CreateObject("Shell.Application" )
Set objFolder = objShell.nameSpace(Chemin)
Set strFileName = objFolder.Items.Item(nomImage)
dimensionsImage = objFolder.getDetailsOf(strFileName, Itm)
Set objShell = Nothing
Set strFileName = Nothing
Set objFolder = Nothing
End Function