صور متساوية المساحة

[مستر ابو مرمر]

ارجو من السادة الخبراء مساعدتي في ادراج عدة صور لكن المشكلة اني اريدهم بمساحة واحدة حتى اتمكن من ترتيبهم بشكل منظم 

هل يوجد كود ينظم هذه العملية

[ياسر خليل أبو البراء]

أخي الكريم مستر أبو مرمر

إليك الكود التالي عله يفي بالغرض

Sub Insert_Pictures_Resize_All()
    Dim PicList()   As Variant
    Dim PicFormat   As String
    Dim Rng         As Range
    Dim sShape      As Shape
    Dim xColIndex   As Integer
    Dim xRowIndex   As Integer
    Dim lLoop       As Integer
    
    On Error Resume Next
    PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
    xColIndex = Application.ActiveCell.Column
    
    If IsArray(PicList) Then
        xRowIndex = Application.ActiveCell.Row
        For lLoop = LBound(PicList) To UBound(PicList)
            Set Rng = Cells(xRowIndex, xColIndex)
            Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
            xRowIndex = xRowIndex + 1
        Next lLoop
    End If
End Sub

قم بضبط ارتفاع الصفوف وعرض العمود كما تريد ..

حدد أول خلية في العمود المطلوب إدراج الصور فيه واضبط عرض العمود كما تريد ثم نفذ الكود ، سيظهر لك نافذة تختار منها المجلد الذي يحتوي الصور ثم حدد الصور المطلوب إدراجها

تقبل تحياتي