Private Sub CommandButton3_Click()
' coller l'image dans la plage de cellule
' en conservant les proportions de l'image
Dim shp, Lplage, HPlage, Lshp, Hshp, r1, r2, r
On Error GoTo ERR_002
Application.ScreenUpdating = False
Application.Goto Plage, False
'charger le fichier image
Set shp = ActiveSheet.Pictures.insert(Fichier)
'dimensions de la plage
Lplage = Cells(Plage.Row, Plage.Column + Plage.Columns.Count).Left - Plage.Left
HPlage = Cells(Plage.Row + Plage.Rows.Count, Plage.Column).Top - Plage.Top
With shp
' maintien du ration de l'image
.ShapeRange.LockAspectRatio = msoTrue
' dimension de l'image
Lshp = .Width: Hshp = .Height
' quelle coefficient appliquer pour re-dimensionner l'image
r1 = Lplage / Lshp: r2 = HPlage / Hshp
If r1 < r2 Then r = r1 Else r = r2
' re-dimensiopnner l'image
.Width = r * .Width
' placer l'image au coin supérieur gauche de la plage
.Top = Plage.Top: .Left = Plage.Left
' applique une bordure
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Line.Visible = True
.ShapeRange.Line.ForeColor.RGB = RGB(100, 100, 100)
.ShapeRange.Line.Weight = 1
.Width = .Width - 2: .Height = .Height - 2
.Top = .Top + 1.5
.Left = .Left + 1.5
End With
shp.Select
Selection.Cut
ActiveSheet.PasteSpecial Format:="Image (jpeg)", Link:=False, DisplayAsIcon _
:=False
Application.ScreenUpdating = True
Exit Sub
ERR_002:
MsgBox "Erreur ! Yé souis décholé..."
End Sub