MACRO insérer et redimensionner une image.

[jeremy42sf]

Bonjour je souhaite:
-Insérer une image dans excel --> Ca c'est fait.
-Appliquer une macro lorsque je clique sur cette image --> Ca c'est fait.
-Et que cette macro, insert dans la cellule active, cette même image --> Ca c'est pas fait.
-Et quelle me redimensionne l'image à la taille de la cellule --> Ca non plus.

Actuellement je suis capable d'insérer une image ou un bouton (c'est déjà pas mal) et d'appliquer une macro (que je construit à l'aide de l'enregistreur) qui m'insère une image de mon HDD.
Je me demande donc quel chemin ou quelle formule mettre pour insérer cette même image depuis le fichier excel afin que sur n'importe quel poste cette macro fonctionne.

Donc actuellement comme macro j'ai ça:

Sub InsérerImage()
'
' InsérerImage Macro
' Macro enregistrée le 13/03/2009 par jceldran
'
' Touche de raccourci du clavier: Ctrl+i
'
ActiveSheet.Pictures.Insert( _
"C:\Users\jceldran\My Pictures\Captures\110_F_5651460_463lMaE4b6a8gE70YPpU4J07qaApMnPG.jpg" _
).Select
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With
End Sub


avec l'option "déplacer et redimensionner avec cellule".

Ensuite en cherchant sur le net j'ai trouvé ça:

.ShapeRange
.LockAspectRatio = msoFalse ---> OTPION
.Height = ActiveCell.Height
.Width = ActiveCell.Width

Mais ne sachant pas construire et programmer en VBA, je ne sais pas ou l'intégrer, j'ai testé des trucs bizarres mais rien ne fonctionne.

Mes question sont donc:

Ou intégrer cela dans ma formule VBA? Je voulais utiliser la fonction d'enregitrement mais je n'ai rien trouvé dans excel pour faire cela.

Et comment insérer l'image qui se trouve dans la feuille?

Voilà.......
J'espère trouver réponse ici.

MERCI

 

[MichelXld]

Re : MACRO insérer et redimensionner une image.

bonsoir

Tu peux utiliser :

Dim Fichier As String
Dim objImg As Object
Dim Emplacement As Range
 
Fichier = "C:\dossier\nom image.jpg"
Set objImg = ActiveSheet.Pictures.Insert(Fichier)
 
Set Emplacement = ActiveCell
Set objImg = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
 
With objImg.ShapeRange
    .LockAspectRatio = msoFalse
    .Left = Emplacement.Left
    .Top = Emplacement.Top
    .Height = Emplacement.Height
    .Width = Emplacement.Width
End With

bonne soirée
michel

 

[jeremy42sf]

Re : MACRO insérer et redimensionner une image.

Merci pour cette réponse mais où dois-je utiliser ceci? J'ai essayé de le coller mais ça ne marche pas, j'ai ajouter SUB..... et END SUB mais ça me met une erreur 1004 et ça me surligne en jaune.

Set objImg = ActiveSheet.Pictures.Insert(Fichier)

Merci.

 

[Dull]

Re : MACRO insérer et redimensionner une image.

Salut jeremy42sf, Michel, le Forum

Remplace ton code par celui de Michel et surtout remplace le chemin de ton image

essaye ça dans un module a part

Sub InsererImage()

Dim Fichier As String
Dim objImg As Object
Dim Emplacement As Range
 
Fichier = "C:\Users\jceldran\My Pictures\Captures\110_F_5651460_463lMaE4b6a8gE70YP pU4J07qaApMnPG.jpg"
Set objImg = ActiveSheet.Pictures.Insert(Fichier)
 
Set Emplacement = ActiveCell
Set objImg = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
 
With objImg.ShapeRange
    .LockAspectRatio = msoFalse
    .Left = Emplacement.Left
    .Top = Emplacement.Top
    .Height = Emplacement.Height
    .Width = Emplacement.Width
End With
End Sub

et normalement tu aura ton image au format de la cellule

Bonne Journée

 

[jeremy42sf]

Re : MACRO insérer et redimensionner une image.

Au temps pour moi, ton code ne marche pas non plus mais c'est ma faute: par erreur j'ai mis un espace dans le chemin de l'image.
Donc merci beaucoup

Une idée pour que cette macro fonctionne sur tous les postes, sans que leurs users possèdent l'image.