REDIMENSIONNER IMAGE EXCEL

Bonjour
Insère une image dans une cellule
http://dj.joss.free.fr/media.htm#inserimg3

En gros....
La largeur de l'image correspondra à la largeur de la cellule
Sub Macro1()
[D13].select
With ActiveWindow
y = .Selection.Width
End With

With Selection.ShapeRange
.Width = y
End With

Daniel
FAQ MPFE
FAQ du forum microsoft.public.fr.excel
http://dj.joss.free.fr/faq.htm

End Sub
"jean louis" <jean-louis.merel@laposte.net> a écrit dans le message de news:
1164970410.344696.69680@j72g2000cwa.googlegroups.com...

Bonjour

Je souhaiterais redimensionner automatiquement une image dans excel

le nom de cette image se trouve en b2 par exemple


et si possible que le redimensionnement soit de la taille de la
cellule d13

voici la formule que j'utilise mais ce la ne fonctionne pas.

en effet il y a un probleme dans hauteur ....

merci beaucoup de votre aide

jean louis








Sub AjusterImageCellule()
Dim li, hi, hc, lc, pr1, pr2 As Double
Set ici = [d13]
Set dessin = [b2]
lc = ici.Width
hc = ici.Height
li = dessin.Width
hi = dessin.Height
pr1 = lc / hc
pr2 = li / hi
If pr1 >= pr2 Then
dessin.Height = hc
dessin.Width = dessin.Height * pr2
End If
If pr1 < pr2 Then
dessin.Width = lc
dessin.Height = dessin.Width / pr2
End If
With dessin
.Left = ici.Left + (ici.Width - .Width) / 2
.Top = ici.Top + (ici.Height - .Height) / 2
End With
End Sub

essaie ceci : Exécute la macro TestMonImage

Le premier paramètre : Nom de l'onglet de la feuille
Deuxième "" : l'étendue (plage de cellules) qui doit contenir l'image
Troisième "" : Nom de l'image.

Attention si tu utilise les noms des images donnés par excel lors de leur insertion
des noms du genre "Image 1" .... en VBA, tu dois traduire "Image 1" par "Picture 1"
si tu utilises des noms personnalisés, aucun problème.

'------------------------
Sub TestMonImage()

InsérerImage "Feuil1", Range("A5:D6"), "Picture 1"

End Sub

'-----------------------------
Sub InsérerImage(Feuille As String, Rg As Range, NomImage As String)

With Worksheets(Feuille)
Largeur = Rg.Offset(, 1)(, Rg.Columns.Count).Left - Rg.Left
Hauteur = Rg.Offset(Rg.Rows.Count).Top - Rg(1).Top
Set Image = .Shapes(NomImage).OLEFormat.Object
End With
With Image
.Left = Rg.Left
.Top = Rg.Top
'Largeur de l'image
Image.Width = Largeur
'Hauteur de l'image
Image.Height = Hauteur
'Est-ce que l'image doit se déplacer avec les cellules
'voici les 3 constantes possibles
.Placement = xlFreeFloating 'or xlmove or xlMoveAndSize
'Verrouillé ou pas
.Locked = True 'or False
End With
Set Rg = Nothing

End Sub
'-----------------------------





"jean louis" <jean-louis.merel@laposte.net> a écrit dans le message de news:
1164970410.344696.69680@j72g2000cwa.googlegroups.com...

Bonjour

Je souhaiterais redimensionner automatiquement une image dans excel

le nom de cette image se trouve en b2 par exemple


et si possible que le redimensionnement soit de la taille de la
cellule d13

voici la formule que j'utilise mais ce la ne fonctionne pas.

en effet il y a un probleme dans hauteur ....

merci beaucoup de votre aide

jean louis








Sub AjusterImageCellule()
Dim li, hi, hc, lc, pr1, pr2 As Double
Set ici = [d13]
Set dessin = [b2]
lc = ici.Width
hc = ici.Height
li = dessin.Width
hi = dessin.Height
pr1 = lc / hc
pr2 = li / hi
If pr1 >= pr2 Then
dessin.Height = hc
dessin.Width = dessin.Height * pr2
End If
If pr1 < pr2 Then
dessin.Width = lc
dessin.Height = dessin.Width / pr2
End If
With dessin
.Left = ici.Left + (ici.Width - .Width) / 2
.Top = ici.Top + (ici.Height - .Height) / 2
End With
End Sub