Resim boyutu kuçültme

[sward175]

Herkese Merhabalar,
Aşağıdaki ( asriakdeniz beyin kodu) kod ile excel sayfasına resim getiriyorum.
Yapmak istediğim sayfada resmin sığacağı kare belirli ama resim bu sınırları taşıyor. Resmi kareye sığdırabilmek için yardımınızı rica ediyorum.
Saygı ve sevgi ile ,
sward175


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C2:C2")) Is Nothing Then Exit Sub
On Error Resume Next
DrawingObjects.Delete
yol = ActiveWorkbook.Path & "\Personel resimleri\" & Cells(2, "C") & ".jpg"
Cells(9, "H").Select
Set sShape = ActiveSheet.Shapes.AddPicture(yol, msoFalse, msoCTrue, Selection.Left, Selection.Top, Selection.Width, Selection.Height)
End Sub

 

[Asri]

H9:I15 arasındaki hücreler birleştirilmiş hücre ise taşma olmaz.

Kodu bu şekilde güncelleyin. Resmi hücre ile beraber taşı boyutlandır yapacaktır.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C2:C2")) Is Nothing Then Exit Sub
     On Error Resume Next
     DrawingObjects.Delete
     yol = ActiveWorkbook.Path & "\Personel resimleri\" & Cells(2, "C") & ".jpg"
     Cells(9, "H").Select
     Set sshape = ActiveSheet.Shapes.AddPicture(yol, msoFalse, msoCTrue, Selection.Left, Selection.Top, Selection.Width, Selection.Height)
     sshape.Placement = xlMoveAndSize
End Sub