اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


الردود الموصى بها

 

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

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

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

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

تم تعديل بواسطه الزهور الفيحاء
رابط هذا التعليق
شارك

2 hours ago, ahmedkamelelsayed0 said:

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

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

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

الماكرو لا يعمل.PNG

1 hour ago, ali mohamed ali said:

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

 

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

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

رابط هذا التعليق
شارك

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

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

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

 

  • Thanks 1
رابط هذا التعليق
شارك

3 hours ago, ahmedkamelelsayed0 said:

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

 

 

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

تم تعديل بواسطه الزهور الفيحاء
  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

  • Thanks 1
رابط هذا التعليق
شارك

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

تم تعديل بواسطه الزهور الفيحاء
اضافة ملف
رابط هذا التعليق
شارك

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

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

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

  • Thanks 1
رابط هذا التعليق
شارك

7 hours ago, ahmedkamelelsayed0 said:

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

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

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

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

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

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

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

  • Like 1
رابط هذا التعليق
شارك

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

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

خطوات نسخ عنصر تحكم.JPG

تم تعديل بواسطه ahmedkamelelsayed0
  • Thanks 1
رابط هذا التعليق
شارك

12 minutes ago, ali mohamed ali said:

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

Data Validation

 بارك الله فيك

 

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

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

 

 

رابط هذا التعليق
شارك

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

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

 

تم تعديل بواسطه ali mohamed ali
رابط هذا التعليق
شارك

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

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

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

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

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

 

  • Thanks 1
رابط هذا التعليق
شارك

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

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

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

ونفع بكم

 

 

 

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

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

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

 

 

 

 

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information