تعديل فى كود

[وائل عزالدين]

السلام عليكم ورحمه الله وبركاته 
من فضلكم كنت محتاج تعديل في كود لأحد خبراء الاكسيل 
كنت عايز مساعده في تعديل في الكود دا بحجم الصور محتاج ان حجم الصور بدل من ان يكون الخليه الحاليه ليكون بحجم المشار اليه في الصوره التاليه 

شكرا جدا لاهتمامكم ومساعدتكم 

" />

دا الكود 

Function VLOOK_Pic1(PicName)

Dim CurrentCel As Range, Pic As Shape
PicName = PicName: MyPath = ThisWorkbook.Path & "data": PicName = MyPath & PicName: ChkPic = Array(".jpg", ".bmp", ".gif", ".png")
Set CurrentCel = Application.Caller
For Each Pic In ActiveSheet.Shapes
    If Pic.Type = msoLinkedPicture Then
        If Pic.Top >= CurrentCel.Top And Pic.Top < CurrentCel.Top + CurrentCel.Height Then
            Pic.Delete
            Exit For
        End If
    End If
Next
For X = LBound(ChkPic) To UBound(ChkPic)
    If Not Dir(PicName & ChkPic(X), vbDirectory) = vbNullString Then
        Set Pic = ActiveSheet.Shapes.AddPicture(PicName & ChkPic(X), True, False, CurrentCel.Left, CurrentCel.Top, CurrentCel.Width, CurrentCel.Height): VLOOK_Pic1 = ""
        Exit For
    Else
        VLOOK_Pic1 = "?? ???? ????"
    End If

Next

End Function

 

[أحمد يوسف]

وعليكم السلام -عليك برفع الملف نفسه

[وائل عزالدين]

1 دقيقه مضت, أحمد يوسف said:

وعليكم السلام -عليك برفع الملف نفسه

شكرا لاهتمامك 

2.xlsm