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



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





اصلاح كود وجود صوره ثابته يوقف الكود

السلام عليكم تكرم علينا الاساتذه زيزو العجوز وياسر الخليل اكرمهم الله بادراج صور الطلاب في بطاقاتهم لكن هناك صوره ثابته ..



11-03-2018 08:25 مساء
ظفر الله عسكر
menu_open
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-12-2017
رقم العضوية : 2747
المشاركات : 83
الجنس : ذكر
يتابعهم : 0
يتابعونه : 4
قوة السمعة : 318
الاعجاب : 78
 offline 
السلام عليكم
تكرم علينا الاساتذه زيزو العجوز وياسر الخليل اكرمهم الله 
بادراج صور الطلاب في بطاقاتهم
لكن هناك صوره ثابته اريدها ان تظهر في جميع البطاقات وهي الشعار والختم 
عند التنفيذ يعطي خطأ في مرحلة ويظلل بالاصفر 
 For Each pics In ws.Pictures





                pics.Delete
            Next pics
    في الملف المرفق الكود  والبطاقات
نرجو المساعد جزاكم الله كل خير
 
 
  بطاقات.zip   تحميل zip مرات التحميل :(4)
الحجم :(68.174) KB







12-03-2018 07:01 صباحا
مشاهدة مشاركة منفردة [1]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 3403
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 11
يتابعهم : 0
يتابعونه : 272
قوة السمعة : 9429
الاعجاب : 3200
 offline 
look/images/icons/i1.gif اصلاح كود وجود صوره ثابته يوقف الكود
وعليكم السلام ورحمة الله

في هذه الحالة يجب أن تقوم باستثناء الصور التي لا تريد حذفها وللتيسير عليك قمت بعمل مصفوفة أحادية تضع فيها أسماء الصور التي لا تريد حذفها أثناء تنفيذ الكود .. وضعت لك مثال وأكمل أنت بقية أسماء الصور التي لا تريد حذفها
غير الجزء التالي في الكود
            Dim v As Variant
            v = Array("صورة 29", "Picture 2")
            For Each pics In ws.Pictures
                If Not IsError(Application.Match(pics.Name, v, 0)) = False Then
                    pics.Delete
                End If
            Next pics

أثارت هذه المشاركة إعجاب: ظفر الله عسكر،




12-03-2018 09:45 صباحا
مشاهدة مشاركة منفردة [2]
ظفر الله عسكر
menu_open
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-12-2017
رقم العضوية : 2747
المشاركات : 83
الجنس : ذكر
يتابعهم : 0
يتابعونه : 4
قوة السمعة : 318
الاعجاب : 78
 offline 
look/images/icons/i1.gif اصلاح كود وجود صوره ثابته يوقف الكود
جزاك الله كل خير وجعله في ميزان حسناتك
عندي صورتين هما
5555.png
6666.jpg
واصبح الكود كالتالي

Sub Test3()
    Dim ws          As Worksheet
    Dim pics        As Object
    Dim c           As Range
    Dim sName       As String
    Dim e           As String
    Dim sPth        As String
    Dim f           As Integer
    Dim l           As Integer
    Dim i           As Long
    Dim cnt         As Long

    Application.ScreenUpdating = False
        Set ws = æÑÞÉ2
        f = Range("ae5").Value
        l = Range("af5").Value
    
        For i = f To l
            cnt = i * 8 - 7
    
            For Each pics In ws.Pictures
             Dim v As Variant
            v = Array("5555.png", "6666.jpg")
            For Each pics In ws.Pictures
                If Not IsError(Application.Match(pics.Name, v, 0)) = False Then
            
                pics.Delete
            Next pics
    
            For Each c In ws.Range("c5,J5,q5,x5,c20,j20,q20,x20")
                c.Value = cnt
                sName = c.Value
                sPth = ThisWorkbook.Path & "\" & "ÕæÑ" & "\"
                e = ".jpg"
    
                If Dir(sPth & sName & e) <> "" Then
                    ws.Shapes.AddPicture Filename:=sPth & sName & e, _
                                         linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=c.Left, _
                                         Top:=c.Top, Width:=(c.Width) * 2, Height:=(c.Height) * 4
                End If
                cnt = cnt + 1
            Next c
            ws.PrintOut
        Next i
    Application.ScreenUpdating = True
End Sub



لكنه لا يعمل بالنسبة لك سهل ولكن بالنسبة لي شيئ عظيم
لا يتابع ويتوقف انظر الصوره فضلا منك وتكرما

 
 
  222.PNG   تحميل png 222.PNG مرات التحميل :(1)
الحجم :(40.444) KB
 






12-03-2018 10:12 صباحا
مشاهدة مشاركة منفردة [3]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 3403
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 11
يتابعهم : 0
يتابعونه : 272
قوة السمعة : 9429
الاعجاب : 3200
 offline 
look/images/icons/i1.gif اصلاح كود وجود صوره ثابته يوقف الكود
الرسالة معناها أن المتغير v معلن عنه من قبل ... قم بحذف أحد السطرين 

أثارت هذه المشاركة إعجاب: ظفر الله عسكر،




12-03-2018 10:51 صباحا
مشاهدة مشاركة منفردة [4]
ظفر الله عسكر
menu_open
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-12-2017
رقم العضوية : 2747
المشاركات : 83
الجنس : ذكر
يتابعهم : 0
يتابعونه : 4
قوة السمعة : 318
الاعجاب : 78
 offline 
look/images/icons/i1.gif اصلاح كود وجود صوره ثابته يوقف الكود
ربي يجبر خاطرك ويجزيك الخير تم الحذف
الكود اصبح

Sub Test()
    Dim ws          As Worksheet
    Dim pics        As Object
    Dim c           As Range
    Dim sName       As String
    Dim e           As String
    Dim sPth        As String
    Dim f           As Integer
    Dim l           As Integer
    Dim i           As Long
    Dim cnt         As Long

    Application.ScreenUpdating = False
        Set ws = ورقة2
        f = Range("ae5").Value
        l = Range("af5").Value
    
        For i = f To l
            cnt = i * 8 - 7
    
            For Each pics In ws.Pictures
             Dim v As Variant
            v = Array("5555", "6666")
          
                If Not IsError(Application.Match(pics.Name, v, 0)) = False Then
            
                pics.Delete
            Next pics
    
            For Each c In ws.Range("c5,J5,q5,x5,c20,j20,q20,x20")
                c.Value = cnt
                sName = c.Value
                sPth = ThisWorkbook.Path & "\" & "صور" & "\"
                e = ".jpg"
    
                If Dir(sPth & sName & e) <> "" Then
                    ws.Shapes.AddPicture Filename:=sPth & sName & e, _
                                         linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=c.Left, _
                                         Top:=c.Top, Width:=(c.Width) * 2, Height:=(c.Height) * 4
                End If
                cnt = cnt + 1
            Next c
            ws.PrintOut
        Next i
    Application.ScreenUpdating = True
End Sub



وظهرت الصوره
 
  55555.PNG   تحميل png 55555.PNG مرات التحميل :(0)
الحجم :(29.972) KB
 






12-03-2018 11:00 صباحا
مشاهدة مشاركة منفردة [5]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 3403
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 11
يتابعهم : 0
يتابعونه : 272
قوة السمعة : 9429
الاعجاب : 3200
 offline 
look/images/icons/i1.gif اصلاح كود وجود صوره ثابته يوقف الكود
السطرين اللي هما بيعلنوا عن المتغير v وبيضعوا قيمة له .. دول حطهم قبل الحلقة التكرارية .. قبل جملة For مش بعد جملة For
 

أثارت هذه المشاركة إعجاب: ظفر الله عسكر،




12-03-2018 11:24 صباحا
مشاهدة مشاركة منفردة [6]
ظفر الله عسكر
menu_open
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-12-2017
رقم العضوية : 2747
المشاركات : 83
الجنس : ذكر
يتابعهم : 0
يتابعونه : 4
قوة السمعة : 318
الاعجاب : 78
 offline 
look/images/icons/i1.gif اصلاح كود وجود صوره ثابته يوقف الكود
جزاك الله خيرا لكن ما عما يتمم
الكود هكذا

Sub Test()
    Dim ws          As Worksheet
    Dim pics        As Object
    Dim c           As Range
    Dim sName       As String
    Dim e           As String
    Dim sPth        As String
    Dim f           As Integer
    Dim l           As Integer
    Dim i           As Long
    Dim cnt         As Long

    Application.ScreenUpdating = False
        Set ws = ورقة2
        f = Range("ae5").Value
        l = Range("af5").Value
    
        For i = f To l
            cnt = i * 8 - 7
      Dim v As Variant
            v = Array("5555", "6666")
          
            For Each pics In ws.Pictures
           
                If Not IsError(Application.Match(pics.Name, v, 0)) = False Then
            
                pics.Delete
            Next pics
    
            For Each c In ws.Range("c5,J5,q5,x5,c20,j20,q20,x20")
                c.Value = cnt
                sName = c.Value
                sPth = ThisWorkbook.Path & "\" & "صور" & "\"
                e = ".jpg"
    
                If Dir(sPth & sName & e) <> "" Then
                    ws.Shapes.AddPicture Filename:=sPth & sName & e, _
                                         linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=c.Left, _
                                         Top:=c.Top, Width:=(c.Width) * 2, Height:=(c.Height) * 4
                End If
                cnt = cnt + 1
            Next c
            ws.PrintOut
        Next i
    Application.ScreenUpdating = True
End Sub




ربي يجبرك ويبارك فيك اكمل المشوار
 
  888888.PNG   تحميل png 888888.PNG مرات التحميل :(0)
الحجم :(41.811) KB
 






12-03-2018 12:07 مساء
مشاهدة مشاركة منفردة [7]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 3403
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 11
يتابعهم : 0
يتابعونه : 272
قوة السمعة : 9429
الاعجاب : 3200
 offline 
look/images/icons/i1.gif اصلاح كود وجود صوره ثابته يوقف الكود
فيه جملة End If مش موجودة .. يبدو إنك حذفتها .. ضع القفلة بعد سطر حذف الصور
 

أثارت هذه المشاركة إعجاب: ظفر الله عسكر،




12-03-2018 02:49 مساء
مشاهدة مشاركة منفردة [8]
ظفر الله عسكر
menu_open
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-12-2017
رقم العضوية : 2747
المشاركات : 83
الجنس : ذكر
يتابعهم : 0
يتابعونه : 4
قوة السمعة : 318
الاعجاب : 78
 offline 
look/images/icons/i1.gif اصلاح كود وجود صوره ثابته يوقف الكود
انا ممنونك واشكرك من الاعماق لم تدخر جهدا استاذي الغالي
لكن تلميذ لم يعرف  اضفت كما تفضلت لكن مو راضي يتمم معي
ان تكرمت علينا بارك الله بك وجزاك الله احسن الجزاء
طلع الاشكال بمكان اخر
 
  787878.PNG   تحميل png 787878.PNG مرات التحميل :(1)
الحجم :(28.77) KB
 






13-03-2018 02:11 صباحا
مشاهدة مشاركة منفردة [9]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 3403
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 11
يتابعهم : 0
يتابعونه : 272
قوة السمعة : 9429
الاعجاب : 3200
 offline 
look/images/icons/i1.gif اصلاح كود وجود صوره ثابته يوقف الكود
ارفق الملف كامل بمجلد الصور لكي تجد المساعدة بشكل أفضل .. وإن شاء الله يساهم الأخوة الأعضاء في الموضوع

أثارت هذه المشاركة إعجاب: ظفر الله عسكر،




13-03-2018 05:14 صباحا
مشاهدة مشاركة منفردة [10]
ظفر الله عسكر
menu_open
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-12-2017
رقم العضوية : 2747
المشاركات : 83
الجنس : ذكر
يتابعهم : 0
يتابعونه : 4
قوة السمعة : 318
الاعجاب : 78
 offline 
look/images/icons/i1.gif اصلاح كود وجود صوره ثابته يوقف الكود
شكرا لك بارك الله بك ما قصرت جزاك الله خيرا
اخوتي اساتذتي الكرام في الملف المرفق مجلد به صور وفيه ملف اكسل
عند الضغط على الزر يتم  ادراج الصور
احببنا نوسع الملف ويكون في بطاقات الطلاب شعار وختم ( الختم شفاف) نريده ان يظهر فوق الصوره مجرد اضفنا الصور للملف
عما يعطي الكود خطأ علما كان شغال بدون اضافة الصور (الشعار والختم)
الختم لحقته png
شكرا لكل من مد يد العون اعانكم الله في الدنيا والاخره
 
 
  55.zip   تحميل zip مرات التحميل :(1)
الحجم :(282.873) KB






13-03-2018 04:33 مساء
مشاهدة مشاركة منفردة [11]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 3403
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 11
يتابعهم : 0
يتابعونه : 272
قوة السمعة : 9429
الاعجاب : 3200
 offline 
look/images/icons/i1.gif اصلاح كود وجود صوره ثابته يوقف الكود
جرب المرفق التالي عله يفي بالغرض
 
 
 
  Pictures Code.rar   تحميل rar مرات التحميل :(2)
الحجم :(216.99) KB


أثارت هذه المشاركة إعجاب: ظفر الله عسكر،




13-03-2018 05:40 مساء
مشاهدة مشاركة منفردة [12]
ظفر الله عسكر
menu_open
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-12-2017
رقم العضوية : 2747
المشاركات : 83
الجنس : ذكر
يتابعهم : 0
يتابعونه : 4
قوة السمعة : 318
الاعجاب : 78
 offline 
look/images/icons/i1.gif اصلاح كود وجود صوره ثابته يوقف الكود
جزاك الله كل خير وبارك الله بك انت مبدع فنان ربي يزيدك علم ورفعه ويحميك بسم الله ما شاء الله
دامت اياديك ممدودة للخير بارك الله بك كل شيء تمام
ربي يحفظك ويبارك فيك
ان تكرمت هل ممكن ان يكون الختم فوق الصوره اذا لايمكن
اتمنى ان تضيف للكود بعد ان يضيف الصور يضيف
ادراج صوره اسمها 5556.png وهي الختم شفافه في الخلايا
("d7,k7,r7,y7,d22,k22,r22,y22"wink_3
وبهذه الحاله يظهر الختم فوق الصوره وليس تحتها
وجزاك الله احسن الجزاء 






المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
محتاج التعديل على كود الموجود على ملف malik
2 31 malik
كيفية البحث في الشيتات الكوجوده داخل ملف الاكسل بدلالة عدة شروط مع كتابة اسم الشيت في خانة العميل alhady
0 22 alhady
كيفية عمل يوزر فورم بحث بالاسم واذا ولم يكن الاسم موجود يعطى عمل ما ibrahem ali
9 196 ibrahem ali
مشكلة عند وجود عدة تبويبات Page فى اليوزرفورم أباالحسن
2 84 YasserKhalil
صلاحية اصناف موجوده بالمخزن amaar
9 195 omar.atra

الكلمات الدلالية
اصلاح ، وجود ، صوره ، ثابته ، يوقف ، الكود ،


 







اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.



الساعة الآن 09:47 مساء

أعلن هنا
أعلن هنا
أعلن هنا