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

[الزهور الفيحاء]

 

ارجوا ازالة التظليل بعد وضع الدوائر ... وما هى الخطوات التى تمت لعمل ذلك

وهل يتم ذلك باستخدام الـ vba  

وطلب بسيط اخر كيف اقوم بإضافة سطر فارغ بين السطور .. لاننى قمت بعمل ذلك بطريقة يدوية متعبه وهى ادراج سطر

استبدال التظليل بدوائر حمراء.xlsx

تم تعديل مايو 22, 2018 بواسطه الزهور الفيحاء

[احمد بدره]

تفضل المرفق وكود لإضافة سطر فارغ في الملف

استبدال التظليل بدوائر حمراء.xlsx

[Ali Mohamed Ali]

وهذا كود اخر لإثراء الموضوع -بعد اذن اخى أحمد

 

-1استبدال التظليل بدوائر حمراء.xlsm

[الزهور الفيحاء]

2 hours ago, ahmedkamelelsayed0 said:

تفضل المرفق وكود لإضافة سطر فارغ في الملف

استبدال التظليل بدوائر حمراء.xlsx

الماكر لا يعمل مع العلم انى قد قمت بتمكين الماكرو ... وقد قمت بارفاق صورة بتلك المشكلة

1 hour ago, ali mohamed ali said:

وهذا كود اخر لإثراء الموضوع -بعد اذن اخى أحمد

 

-1استبدال التظليل بدوائر حمراء.xlsm

هل من الصعب تعلم هذا الكود لاننى اود ان اقوم بنفسي بعمل هذا .. ان سمح وقت حضرتك لاننى احتاج القيام ببعض التعديلات مثل استثناء بعض الخلايا من الدوائر وغير ذلك

[Ali Mohamed Ali]

هناك شرح داخلى لكود وضع الدوائر يمكنك تغيير واختيار العمدة التى تريد وضع الدوائر بها

وهذا هو الكود مع شرح بسيط له

Option Explicit
Option Base 1
Sub DrawRedCircles()
    Dim myArray     As Variant
    Dim Rng         As Range
    Dim Cel         As Range
    Dim Cell        As Range
    Dim L           As Long
    Dim T           As Long
    Dim W           As Long
    Dim H           As Long
    Dim X           As Long
    Dim rRow        As Long
    Dim startRow    As Long

    'مصفوفة بأسماء الأعمدة المراد وضع دوائر حمراء بها
    myArray = Array("Q", "U", "Z", "AD", "AI", "AM", "AS", "AT", "AU", "AY", "BE", "BF", "BG", "BK", "BN", "BQ", "BR", "BW", "CA", "CG", "CH", "CI", "CM", "CR", "CV")

    'رقم الصف الذى يحتوى على الدرجات النهائية الصغرى
    rRow = 9

    'صف البداية أى أول صف به درجات الطلاب
    startRow = 10

    Application.ScreenUpdating = False
        Call RemoveCircles
        
        With Sheets("Sheet1")
            For X = LBound(myArray) To UBound(myArray)
                Set Cel = .Range(myArray(X) & rRow)
                Set Rng = .Range(myArray(X) & startRow, .Range(myArray(X) & startRow).End(xlDown))
    
                For Each Cell In Rng
                    If Cell.Value < Cel Or Cell.Value = "Û" Then
                        L = Cell.Left: T = Cell.Top
                        W = Cell.Width: H = Cell.Height
    
                        With .Shapes.AddShape(msoShapeOval, L, T, W, H)
                            .Fill.Visible = msoFalse
                            .Line.ForeColor.RGB = RGB(255, 0, 0)
                            .Line.Transparency = 0
                            .Line.Weight = 1.5
                        End With
                    End If
                Next Cell
            Next X
        End With
    Application.ScreenUpdating = True
End Sub

 

[الزهور الفيحاء]

3 hours ago, ahmedkamelelsayed0 said:

بارك الله فيك وذادك علما  واشكرك على سعة صدرك

 

 

الماكر لا يعمل مع العلم انى قد قمت بتمكين الماكرو ... وقد قمت بارفاق صورة بتلك المشكلة

تم تعديل مايو 22, 2018 بواسطه الزهور الفيحاء

[احمد بدره]

تفضل الملف وبعد إذن الأستاذ علي لإثراء الموضوع تم عمل كود إضافة الدوائر وكود حذف الدوائر بزر أمر واحد

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

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

-1استبدال التظليل بدوائر حمراء.xlsm

[الزهور الفيحاء]

18 hours ago, ahmedkamelelsayed0 said:

تفضل الملف وبعد إذن الأستاذ علي لإثراء الموضوع تم عمل كود إضافة الدوائر وكود حذف الدوائر بزر أمر واحد

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

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

-1استبدال التظليل بدوائر حمراء.xlsm

الله الله الله بارك الله فيكم وذادكم علما

وغفر الله لكم ذنوبكم ورحم موتاكم

[الزهور الفيحاء]

21 hours ago, ahmedkamelelsayed0 said:

تفضل الملف وبعد إذن الأستاذ علي لإثراء الموضوع تم عمل كود إضافة الدوائر وكود حذف الدوائر بزر أمر واحد

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

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

-1استبدال التظليل بدوائر حمراء.xlsm

ارجوا الا اكون اثقلت على السادة الافاضل

ارجو تعديل الكود لكى يضع الدوائر الحمراء فى اماكن محددة فى كل مادة وهى الحصول على درجة الربع  21   والنهاية الصغرى لكل مادة والنهاية الصغرى للمجموع الكلى كالآتى

اللغة العربية  العمود q  والعمود u

 

اللغة الانجليزية العمود Z  والعمود AD

 

الدراسات الاجتماعية العمود  AI  والعمود AM

 

الرياضيات العمود AU  والعمود AY

 

العلوم العمود BG  والعمود  BK

 

المجموع الكلى  العمود BR

 

التربية الدينية العمود BW  والعمود CB

 

الحاسب الآلى العمود CI   والعمود CM

 

التربية الفنية العمود CR  والعمود CV

 

 

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

 

-1استبدال التظليل بدوائر حمراء(1).xlsm

تم تعديل مايو 23, 2018 بواسطه الزهور الفيحاء
اضافة ملف

[احمد بدره]

تم تعديل الكود ليتناسب مع كل الأعمدة ابتداءًا من العمودM إلى العمودCV كل ما عليك هو وضع رقم الدرجة للنهاية الصغرى في الصف رقم 9 للأعمدة المطلوب وضع دوائر لها

الشرط الثاني لوضع الدوائر هو أن يكون نطاق خلايا العمود c في الصفوف غير فارغ

-1استبدال التظليل بدوائر حمراء.xlsm

[الزهور الفيحاء]

7 hours ago, ahmedkamelelsayed0 said:

تم تعديل الكود ليتناسب مع كل الأعمدة ابتداءًا من العمودM إلى العمودCV كل ما عليك هو وضع رقم الدرجة للنهاية الصغرى في الصف رقم 9 للأعمدة المطلوب وضع دوائر لها

الشرط الثاني لوضع الدوائر هو أن يكون نطاق خلايا العمود c في الصفوف غير فارغ

-1استبدال التظليل بدوائر حمراء.xlsm

بارك الله فيك وجزاك الله خيرا 

لقد قمت بالتجربة وتم حل المشكلة السابقة 

وطلب اخير ان كان هناك وقت عند حضرتك .. كيف اقوم بوضع الازرار وبرمجتها 

حيث اننى نسخت الكود ووضعته مباشرة داخل نافذة الفيجوال فى ملف اخر  وقمت بتشغيل الماكرو وتم تنفيذ الكود بنجاح . .. لكن دون وجود الازرار بمعنى انه تم وضع الدوائر .. لكن الزر المتجكم غير موجود 

[احمد بدره]

من فضلك اتبع الخطوات التي في الصورة  الشكل رقم 1 في الملف القديم  وباقي الأشكال تتبع في الملف الجديد

مع خالص تحياتي

تم تعديل مايو 24, 2018 بواسطه ahmedkamelelsayed0

[الزهور الفيحاء]

 

ماذا عن استخدام   datavalidation  فى اضافة الدوائر الحمراء

كيف يتم ذلك

 

[Ali Mohamed Ali]

لا يمكن اضافة الدوائر الحمراء عن طريق 

Data Validation

بارك الله فيك

[الزهور الفيحاء]

12 minutes ago, ali mohamed ali said:

لا يمكن اضافة الدوائر الحمراء عن طريق 

Data Validation

 بارك الله فيك

 

لقد شاهدت مقطع على اليوتيوب يشرح ذلك لكننى لم اجربه 

لذا احببت ان ان استشير اساتذى فى ذلك

 

 

[Ali Mohamed Ali]

صحيح اخى الكريم ولكنها لا تظهر فى الطباعة ولا تحفظ

Option Explicit
Option Base 1
Sub DrawRedCircles()
    Dim myArray     As Variant
    Dim Rng         As Range
    Dim Cel         As Range
    Dim Cell        As Range
    Dim L           As Long
    Dim T           As Long
    Dim W           As Long
    Dim H           As Long
    Dim X           As Long
    Dim rRow        As Long
    Dim startRow    As Long

    'مصفوفة بأسماء الأعمدة المراد وضع دوائر حمراء بها
    myArray = Array("Q", "U", "Z", "AD", "AI", "AM", "AS", "AT", "AU", "AY", "BE", "BF", "BG", "BK", "BN", "BQ", "BR", "BW", "CA", "CG", "CH", "CI", "CM", "CR", "CV")

    'رقم الصف الذى يحتوى على الدرجات النهائية الصغرى
    rRow = 9

    'صف البداية أى أول صف به درجات الطلاب
    startRow = 10

    Application.ScreenUpdating = False
        Call RemoveCircles
        
        With Sheets("Sheet1")
            For X = LBound(myArray) To UBound(myArray)
                Set Cel = .Range(myArray(X) & rRow)
                Set Rng = .Range(myArray(X) & startRow, .Range(myArray(X) & startRow).End(xlDown))
    
                For Each Cell In Rng
                    If Cell.Value < Cel Or Cell.Value = "Û" Then
                        L = Cell.Left: T = Cell.Top
                        W = Cell.Width: H = Cell.Height
    
                        With .Shapes.AddShape(msoShapeOval, L, T, W, H)
                            .Fill.Visible = msoFalse
                            .Line.ForeColor.RGB = RGB(255, 0, 0)
                            .Line.Transparency = 0
                            .Line.Weight = 1.5
                        End With
                    End If
                Next Cell
            Next X
        End With
    Application.ScreenUpdating = True
End Sub

 

تم تعديل مايو 26, 2018 بواسطه ali mohamed ali

[احمد بدره]

أفضل الطرق في اعتقادي الذي قدمتها لك  لأنها

تتيح لك وضع الدوائر في أي أعمدة  في المدى كل ما عليك وضع درجة النهاية الصغرى للعمود المطلوب

إضافة إلى ذلك أنها تعمل في أي ورقة عمل نشطة

ومرتبطة بأن تكون خلية العمود c غير فارغة

وصراحة كل أعضاء المنتدى لا يبخلون على أحد بأي معلومة

 

[الزهور الفيحاء]

On 5/23/2018 at 2:53 AM, ahmedkamelelsayed0 said:

الف الف شكر للسادة الافاضل عمالقة الاكسيل بمنتدانا الغالى الذى لم ارى منتدى آخر اكثر ايجابية وتعاون منه على شبكة الانترنت

بارك الله فيكم و زادكم علما

ونفع بكم

 

 

 

On 5/23/2018 at 2:53 AM, ahmedkamelelsayed0 said:

اساتذتى الافاضل

كيف لى ان ابدأ فى تعلم البرمجة باستخدام الاكسيل .. حيث اننى استطيع التعامل مع برنامج  فيجوال بيسك دوت نت .. لكننى لاحظت وجود بعض الاوامر والاكواد والتى لا استطيع فهمها ولم ارها مسبقا فى برنامج الـ VB.NET ارجوا من سيادتكم ارشادى لتعلم ذلك حيث اننى اتعرض كثيرا لبعض المواقف التى لا استطيع فهما مثل التعامل مع اوراق العمل الخاصة بالكنترول شيت وغيره ولا استطيع التعامل معه وفهمه للتعديل به ان اممكن وعمل واجهه بها ازرار وبرمجتها ومن ثم القيام ببناء كنترول شيت خاص بي