أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
ashraf_hertlion hassona229-- لا تميز خلال هذه الفترة YasserKhalil مطلوب تعديل الكود للطباعة اكسيل اسئله واجابات


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





كود وضع دوائر حول الحصص

لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب المطلوب كود وضع دوائر حول الحصص المظلله في الجدول ويكون الد ..


موضوع مغلق

الصفحة 1 من 3 < 1 2 3 > الأخيرة »


03-12-2021 07:16 مساء
صقر
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 08-06-2020
رقم العضوية : 19493
المشاركات : 39
الجنس : ذكر
تاريخ الميلاد : 11-11-1966
يتابعهم : 2
يتابعونه : 0
قوة السمعة : 51
 offline 





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










 
 
  وضع دوائر حول الحصص.xls   تحميل xls مرات التحميل :(5)
الحجم :(28.672) KB



أفضل إجابة مقدمة من YasserKhalil وهي:
الشكر موصول للأخ حسونة على الكود الرائع
قمت بتعديل كود أخونا الغالي حسونة ليتناسب مع طلبك حسب ما فهمت (إذا أردت تعديل أي جزئية في طلبك قم بدراسة الكود وحاول التعديل بنفسك)
Sub Draw_Circles()
    Const nMax As Integer = 30
    Dim mx, v As Shape, x As Integer, r As Long, c As Long, cnt As Long
    Call Remove_Circles
    x = ActiveWindow.Zoom
    Application.ScreenUpdating = False
    ActiveWindow.Zoom = 100
    mx = Sheet1.Range("N2").Value
    If mx = 0 Or Not IsNumeric(mx) Then MsgBox "Enter Valid Number In Cell N2", vbExclamation: GoTo Skipper
    For c = 10 To 8 Step -1
        For r = 4 To 14 Step 2
            With Sheet1.Cells(r, c)
                If .Value <> "" Then
                    cnt = cnt + 1
                    Set v = .Parent.Shapes.AddShape(msoShapeOval, .Left + 1, .Top + 1, .Width - 2, .Height - 2)
                    v.Fill.Visible = msoFalse
                    v.Line.ForeColor.SchemeColor = 10
                    v.Line.Weight = 1
                    If cnt = mx Then Exit For
                End If
            End With
        Next r
        If cnt = mx Then Exit For
    Next c
    cnt = 0
    For c = 2 To 10
        For r = 20 To 30 Step 2
            With Sheet1.Cells(r, c)
                If .Value <> "" Then
                    cnt = cnt + 1
                    Set v = .Parent.Shapes.AddShape(msoShapeOval, .Left + 1, .Top + 1, .Width - 2, .Height - 2)
                    v.Fill.Visible = msoFalse
                    v.Line.ForeColor.SchemeColor = 10
                    v.Line.Weight = 1
                    If cnt = nMax Then Exit For
                End If
            End With
        Next r
        If cnt = nMax Then Exit For
    Next c
Skipper:
    ActiveWindow.Zoom = x
    Application.ScreenUpdating = True
    MsgBox "Done...", 64
End Sub

Private Sub Remove_Circles()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If shp.AutoShapeType = msoShapeOval Then shp.Delete
    Next shp
End Sub
عرض الإجابة




04-12-2021 02:07 صباحا
مشاهدة مشاركة منفردة [1]
hassona229
مشرف عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2018
رقم العضوية : 9257
المشاركات : 808
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 13-9-1980
يتابعهم : 0
يتابعونه : 11
قوة السمعة : 4330
عدد الإجابات: 113
 offline 
look/images/icons/i1.gif كود وضع دوائر حول الحصص
السلام عليكم ورحمه الله وبركاته وبها نبدأ

جرب هذا التعديل

Option Explicit
Sub اضافة_حذف()
On Error Resume Next
Dim XX As Shape
Set XX = ActiveSheet.Shapes("الدائرة")
With XX.TextFrame.Characters
    If .Text = "إضافة الدوائر" Then
       Circles1
       .Text = "حذف الدوائر"
    Else
       RemoveCircles1
       .Text = "إضافة الدوائر"
    End If
End With
On Error GoTo 0
End Sub
Sub Circles1()
Dim c As Range
Dim MyRng As Range, V As Shape
Dim X As Integer, d As Integer
'================================================
Set MyRng = Range("e4:j6000")  ' نطاق الخلايا الذي تريد اضافة الدوائر فيها
'================================================
X = ActiveWindow.Zoom
Application.ScreenUpdating = False
ActiveWindow.Zoom = 100
For Each c In MyRng
If c.Interior.Color = 65535 And c.Value <> "" Then
    Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, c.Left + 1, c.Top + 1, c.Width - 2, c.Height - 2)
        V.Fill.Visible = msoFalse
        V.Line.ForeColor.SchemeColor = 10
        V.Line.Weight = 3
        d = d + 1
    End If
1 Next
ActiveWindow.Zoom = X
Application.ScreenUpdating = True
MsgBox "تم إضافة   " & d & "   دائرة بنجاح", vbMsgBoxRtlReading, "الحمدلله"
End Sub
Sub RemoveCircles1()
    Dim shp As Shape, d As Integer
    For Each shp In ActiveSheet.Shapes
      If shp.AutoShapeType = msoShapeOval Then shp.Delete: d = d + 1
    Next shp
MsgBox "تم حذف   " & d & "   دائرة بنجاح", vbMsgBoxRtlReading, "الحمدلله"
End Sub

04-12-2021 05:11 صباحا
مشاهدة مشاركة منفردة [2]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif كود وضع دوائر حول الحصص
بارك الله فيك أخي العزيز حسونة
في الحقيقة الطلب غير دقيق وغير واضح ففي الملف في الجدول الأول ذكرت أنك تريد آخر 8 حصص في الجدول ويوجد 9 حصص مظللة بالأصفر وليس 8 وما هي الطريقة التي تحدد بها آخر 8 حصص أي كيف للكود أن يتعرف على آخر 8 حصص .. كذلك الأمر بخصوص الجدول الثاني كيف سيكون التحديد لعدد الحصص وهل وضع الدوائر مرتبط بلون الخلية فقط
وكيف ستقوم بتغيير اسم المعلم وهل مع تغيير اسم المعلم ستتغير الخلايا باللون الأصفر تلقائياً أن اللون الأصفر هو مجرد وسيلة لتشرح بها المطلوب؟
الرجاء الرد على كل سؤال من الأسئلة التي وجهتها لك.

04-12-2021 11:39 صباحا
مشاهدة مشاركة منفردة [3]
صقر
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 08-06-2020
رقم العضوية : 19493
المشاركات : 39
الجنس : ذكر
تاريخ الميلاد : 11-11-1966
يتابعهم : 2
يتابعونه : 0
قوة السمعة : 51
 offline 
look/images/icons/i1.gif كود وضع دوائر حول الحصص
السلام عليكم ورحمة الله وبركاته
استاذنا الفاضل اعتذر عن عدم وضوح المطلوب 
التظليل باللون الاصفر هو للايضاح فقط اما تغيير اسم المدرس فينم عن طريق زر زيادة ونقصان
والمدرس له جدولان صباحى ومسائي والحصص يحسب له عدد من الحصص في الجدول الصباحى يتراوح بين 6 حصص و8 حصص من الحصص الاخيرة بالجدول  
وفى الجدول المسائي يحسب له 30 حصة بشرط ان تكون من بداية الجدول اى من بداية الجدول وتترك الحصص الحروقة في نهاية الجدول 
ولو تتذكر حضرتك كنت ساعدتنى فى كود الحصص للجدول الثانى ولكم كل الشكر والاحترام

04-12-2021 11:53 صباحا
مشاهدة مشاركة منفردة [4]
صقر
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 08-06-2020
رقم العضوية : 19493
المشاركات : 39
الجنس : ذكر
تاريخ الميلاد : 11-11-1966
يتابعهم : 2
يتابعونه : 0
قوة السمعة : 51
 offline 
look/images/icons/i1.gif كود وضع دوائر حول الحصص
المطلوب ايضاً هو ان احدد انا عدد الخلايا المطلوب وضع دائرة عليها ونطاقها عن طريق وضع العدد في خلية والنطاق في خلية وينفذ الكود المطلوب واسف على الاطالة وعلى ارهاقكم ولكن لو تم المطلوب سيكون مفيد لكثير من المعلمين الذين يضيع منهم الكثير من الوقت في عمل الحصص الزائدة 

04-12-2021 01:13 مساء
مشاهدة مشاركة منفردة [5]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif كود وضع دوائر حول الحصص
كيف يتم تحديد الحصص الأخيرة أو الأولى ..؟ حاول إدراج صورة توضيحية لهذه النقطة.

04-12-2021 01:21 مساء
مشاهدة مشاركة منفردة [6]
صقر
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 08-06-2020
رقم العضوية : 19493
المشاركات : 39
الجنس : ذكر
تاريخ الميلاد : 11-11-1966
يتابعهم : 2
يتابعونه : 0
قوة السمعة : 51
 offline 
look/images/icons/i1.gif كود وضع دوائر حول الحصص
الحصص الاخيرة للمعلم من الحصة السابعة حتى الحصة التاسعة وهى متغيرة غير ثابتة بمعنى ان النطاق من الحصة السابعة حتى التاسعة اياً كان عدد الحصص به المطلوب وضع دوائر حول اخر 6 او 8 حصص به خلال الخمس ايام عمل اما الحصص الاولى بالجدول الاخر فهى اول 30 حصة فى نطاق من الححصة الاولى وحتى التاسعة خلال الخمس ايام عمل ويكون تحديد عدد الخلايا من حلال خلية اضع انا بها العدد ارجو ان اكون وضحت المطلوبولكم جزيل الشكر على صبركم وسعة صدركم


الصفحة 1 من 3 < 1 2 3 > الأخيرة »


الكلمات الدلالية
دوائر ، الحصص ،


 










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

الساعة الآن 08:04 مساء