اظهار الصورة vlookup

[ابوحمزه المصرى]

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

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

بارك الله فيكم

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

وعليكم السلام

ارفق ملف لتتضح صورة طلبك بشكل أفضل ..

[ابوحمزه المصرى]

شكراً أخى الفاضل  ابو البراء على الاهتمام اليك مثال مصغر

pic.rar

 

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

أين الصور المطلوب إدراجها؟ هل في نفس المصنف في ورقة عمل أخرى أم في مجلد خارجي يشار إليه بشكل معين ؟؟

قم بإرفاق الملف معبر عن الطلب لمحاولة تقديم المساعدة بالشكل المطلوب من قبل الأخوة الأعضاء

[ابوحمزه المصرى]

اخى الفاضل ابو البراء اريد الصور بفولدر pic بنفس مسار الملف المرفق

pc.rar

 

[ياسر العربى]

جرب المرفق لعله المطلوب

تحياتي 

pc.rar

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

بسم الله ما شاء الله عليك يا عربي متميز كالعادة ..

إضافة بسيطة لمسح الصور في حالة عدم وجود الاسم

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myPath As String, fullImagePath As String

    If Target.Address = "$B$1" Then
        myPath = ThisWorkbook.Path & "\pic\"
        fullImagePath = myPath + [B1]

        On Error GoTo Skipper
        Image1.Picture = LoadPicture(fullImagePath & "1.JPG")
        Image2.Picture = LoadPicture(fullImagePath & "2.JPG")
        Image3.Picture = LoadPicture(fullImagePath & "3.JPG")
        Image4.Picture = LoadPicture(fullImagePath & "4.JPG")
        Exit Sub
    End If
    
Skipper:
    Image1.Picture = LoadPicture("")
    Image2.Picture = LoadPicture("")
    Image3.Picture = LoadPicture("")
    Image4.Picture = LoadPicture("")
End Sub

 

[ياسر العربى]

وطول عمرى كسول :) 
وحتى كسلت اعلن عن المتغيرات 
المهم اللي يعدل علينا حبايبنا 
تسلملي حبيبي 
تحياتي لك

[ابوحمزه المصرى]

شكر واجب لكما وبارك الله فيكما  " اخى الفاضل ياسر العربى واخى الفاضل ابو البراء " على الكود الرائع .  والله  انى احبكما فى الله

لكن كنت اود ان اضيف عندما لا توجد صورة يكتب ذلك مكان الصورة بالاضافة اننى اريد ان اعرف لماذا لا يتم تحديد الخلايا الموجود بها الصور

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

الأخ الغالي ياسر العربي إنت الأصل في الكود .. المبدع ليس كالمقلد

أخي أبو حمزة

وضعت أدوات Image في الخلايا التي بها الصور ..ادخل على التبويب Developer ثم انقر Design Mode ويمكنك بعدها تحديد تلك الأدوات

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

[ابوحمزه المصرى]

اخى الفاضل ابو البراء طبقت تعليماتك واضفت صورة no.jpg لكن للاسف عندما لا تتوفر صورة واحده لا يعرض باقى الصور للشخص ... انظر الى الكود لعل اكون مخظئ فى التنفيذ 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myPath As String, fullImagePath As String

        myPath = ThisWorkbook.Path & "\pic\"
        fullImagePath = myPath + [B1]
If Target.Address = "$B$1" Then

        On Error GoTo Skipper
        Image1.Picture = LoadPicture(fullImagePath & "1.JPG")
        Image2.Picture = LoadPicture(fullImagePath & "2.JPG")
        Image3.Picture = LoadPicture(fullImagePath & "3.JPG")
        Image4.Picture = LoadPicture(fullImagePath & "4.JPG")
        Exit Sub
    End If
    
Skipper:
    Image1.Picture = LoadPicture(myPath & "NO.jpg")
    Image2.Picture = LoadPicture(myPath & "NO.jpg")
    Image3.Picture = LoadPicture(myPath & "NO.jpg")
    Image4.Picture = LoadPicture(myPath & "NO.jpg")
End Sub

 

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

ارفق الملف للإطلاع عليه ..لنرى المشكلة عن قرب ..

يبدو أنه عندما لا تتوافر صورة واحد يحدث خطأ فينتقل الكود بالجزء الثاني من الكود مما يجعل الصور لا تظهر كليةً

[ابوحمزه المصرى]

تفضل اخى الكريم ابوالبراء

pc.rar

[ابوحمزه المصرى]

up

 

[ابوحمزه المصرى]

up

 

[ابوحمزه المصرى]

up

 

[ابوحمزه المصرى]

up

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

أخي الكريم أبو حمزة

جرب الكود بالشكل التالي

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myPath As String, fullImagePath As String

    myPath = ThisWorkbook.Path & "\pic\"
    fullImagePath = myPath + [B1]
    
    If Target.Address = "$B$1" Then
        If Dir(fullImagePath & "1.JPG") <> "" Then
            Image1.Picture = LoadPicture(fullImagePath & "1.JPG")
        Else
            Image1.Picture = LoadPicture(myPath & "NO.JPG")
        End If
        '=========================================================
        If Dir(fullImagePath & "2.JPG") <> "" Then
            Image2.Picture = LoadPicture(fullImagePath & "2.JPG")
        Else
            Image2.Picture = LoadPicture(myPath & "NO.JPG")
        End If
        '=========================================================
        If Dir(fullImagePath & "3.JPG") <> "" Then
            Image3.Picture = LoadPicture(fullImagePath & "3.JPG")
        Else
            Image3.Picture = LoadPicture(myPath & "NO.JPG")
        End If
        '=========================================================
        If Dir(fullImagePath & "4.JPG") <> "" Then
            Image4.Picture = LoadPicture(fullImagePath & "4.JPG")
        Else
            Image4.Picture = LoadPicture(myPath & "NO.JPG")
        End If
    End If
End Sub

 

[ابوحمزه المصرى]

تم العمل بالكود  بنجاح .. اشكرك اخى الغالى ابو البراء على المجهود الرائع .. بارك الله فيك

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

الحمد لله الذي بنعمته تتم الصالحات

مشكور على كلماتك الطيبة

تقبل تحياتي

[۩◊۩ أبو حنين ۩◊۩]

اخى الحبيب ....ياسر ابو البراء

دائما موجود  ... حيث نحتاج وجودك

جزاك الله كل الخير .... كود رائع رائع

 

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

بارك الله فيك أخي العزيز أبو حنين وجزيت خيراً على مرورك العطر