السلام عليكم ورحمة الله وبركاته

إخواني وأحبابي في الله

النهاردة حبيت أقدم لكم كود ممكن يكون مفيد ليكم ، لأنه هيوفر عليك وقت كبير .. والكود بسيط ويقوم الكود بإدراج مجموعة من الصور ودي هتحددها بنفسك من أي مجلد للصور ، وبعد تحديد المسار سيب الباقي على الكود ...



داخل الكود ممكن تحدد العمود اللي هيتم وضع الصور فيه .. شوف التعليق Column Number هتلاقيه 2 أي العمود B أي العمود التاني (بكلمكم بكل اللغات عربي وإنجليزي وأرقام)
وكمان ممكن تحدد صف البداية ودا هتلاقوه في التعليق Row Number ودا 1 ، كرقم البداية لأول صف

خلاص كدا .. بكدا إنت هتحدد مسارك ، وعمودك ، وصفك .. سيب الباقي على الكود

الكود سيقوم بإدراج الصور اللي سعادتك حددت مسارها ، ويدرجها في العمود اللي إنت حددته ، في أول صف إنت حددته .. ويظبط الصور على مقاس الخلية اللي عندك .. عشان كدا لازم تظبط ارتفاع الصفوف اللي هيتم فيها إدراج الصور عشان تكون الصور المدرجة مظبوطة
بس كدا .. لا لسه !! وكمان أسماء الصور دي هتلاقيها في العمود اللي على يسار عمود الصور ..

أرجو أن تستفيدوا من الكود .. وأخيراً بعد الرغي والكلام اللي ملوش لازمة بس له لازمة إليكم الكود ...

Sub Insert_Pictures_To_Worksheet_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)
    xRowIndex = 1       'Row Number
    xColIndex = 2       'Column Number
    
    If IsArray(picList) Then
        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)
            rng.Offset(, -1).Value = Split(Split(picList(lLoop), "")(UBound(Split(picList(lLoop), ""))), ".")(0)
            xRowIndex = xRowIndex + 1
        Next lLoop
    End If
End Sub

بعد تنفيذ الكود هتلاقي النتيجة بالشكل ده



وأخيراً إليكم الملف مرفوع على رابط خارجي (ومحدش يطلب مني أرفعه بالمنتدى .. اتعب شوية عشان تدعمني ..دا لو حابب تدعمني)

رابط الملف المرفق من هنا

إعداد وتقديم / ياسر خليل أبو البراء