inserer et redimensionner une image

[benjamin]

bonjour a tous
j'ai un petit problème en vba et oui encore
j'ai cette source:
Sub imgComment()
On Error Resume Next
Dim nom$
For Each c In Selection
nom = c.Value
If Not c = '' Then
With c
.AddComment
.Comment.Shape.Fill.UserPicture ActiveWorkbook.Path & '\\' & 'Photos' & '\\' & nom & '.jpg'
.Comment.Visible = False
'Masque le commentaire
End With
End If
Next
End Sub

cette macro fonctionne très bien mais ...
je voudrais que l'image que j'insère soit redimensionner suivant sa taille car sinon tout les commentaires ont la meme taille et donc les images sont disproportionnées
voila si qqun peut m'aider je l'en remercie d'avance
Merci

 

[antiphot]

Bonjour Benjamin, le Forum

Je ne sais pas si cela te conviendra, mais Michel XlD a fait une macro qui me semble correspondre a ce que tu veux. Je me suis permis de la modifier juste de façon à ce qu'elle réponde à tes besoins.

A toi ensuite de l'adapter en fonction du nombre d'images que tu veux insérer

tiens moi au courant

 

[antiphot]

Décidémment, j'ai des probl avec l'envoi de fichiers aujourdhui ! [file name=insererimage.zip size=9639]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/insererimage.zip[/file]

 

[benjamin]

je te remercie d'avoir chercher mais g pas réussi a extraire ce qui m'interessais dans cette source, car je souhaite inserer mes images dans un commentaire donc c quand même pas tout a fait la meme chose.
car quand j'ajoute mes images dans un commentaire elle ne sont jamais aux bonnes proportions
merci quand même

 

[antiphot]

Effectivement, j'avais lu ton post en travers !
Désolé mais là je ne vois pas. Par contre si une solution existe j'avoue que je serais également preneur.

 

[MichelXld]

Redimensionner commentaire à la taille de l'image

bonjour Benjamin , bonjour antiphot


j'espere que cette adaptation repondra à ta demande

Sub ajoutImageCommentaire()
Dim Nom As Variant, Repertoire As Variant
Dim C As Range

Repertoire = ActiveWorkbook.Path & '\\\\\\\\Photos\\\\\\\\'

For Each C In Selection
Nom = C.Value

If Not C = '' Then
With C
.AddComment
.Comment.Shape.Fill.UserPicture Repertoire & Nom & '.jpg'
.Comment.Visible = False 'Masque le commentaire
End With

With C.Comment.Shape
.Width = Val(dimensionsImage(Repertoire, Nom & '.jpg', 27))
.Height = Val(dimensionsImage(Repertoire, Nom & '.jpg', 28))
End With

End If

Next
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




bonne soirée
MichelXld

Message édité par: michelxld, à: 04/05/2006 21:14

 

[benjamin]

Re:Redimensionner commentaire à la taille de l'image

bonjour
j'aimerais bien savoir a quoi correspond le 27 et le 28 situé dans la commande pour redimensionné le commentaire ?
je ne vois pas ce que ces 2 nombres viennet faire ici
merci de me renseigner

 

[MichelXld]

Re:Redimensionner commentaire à la taille de l'image

bonjour Benjamin

ce sont 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...


Ce lien n'existe plus


bonne soirée
MichelXld

 

[benjamin]

Re:Redimensionner commentaire à la taille de l'image

bonjour MichelXld

j'ai qques pb avec la macro qui permet d'ajouter des photos au commentaires.
je voulais deja savoir si il y avait une limite de caractère pke avec certaine cellules je ne peut pas ajouter des commentaire mais ce k'il y a de bizare c'est que les commentaires sont bien redimmensionné mais il n'y a pas la photo.
ci joint un exemple pour lekel je n'arrive pas a faire marcher la macro.. [file name=test_20060510102926.zip size=17416]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/test_20060510102926.zip[/file]

 

[MichelXld]

Re:Redimensionner commentaire à la taille de l'image

bonsoir Benjamin

tu as oublié un antislash dans cette ligne

Repertoire = ThisWorkbook.Path


réessaye en utilsant

Repertoire = ThisWorkbook.Path & '\\\\\\\\'



bonne soirée
MichelXld