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

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

قام بنشر (معدل)

 

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

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

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

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

تم تعديل بواسطه الزهور الفيحاء
قام بنشر
  في 22‏/5‏/2018 at 19:22, ahmedkamelelsayed0 said:

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

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

Expand  

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

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

  في 22‏/5‏/2018 at 20:22, ali mohamed ali said:

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

 

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

Expand  

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

قام بنشر

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

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

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
قام بنشر (معدل)
  في 22‏/5‏/2018 at 19:22, ahmedkamelelsayed0 said:

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

 

 

Expand  

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

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

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

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

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

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

  • Thanks 1
قام بنشر
  في 23‏/5‏/2018 at 00:53, ahmedkamelelsayed0 said:

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

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

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

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

Expand  

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

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

قام بنشر (معدل)
  في 23‏/5‏/2018 at 00:53, ahmedkamelelsayed0 said:

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

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

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

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

Expand  

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

ارجو تعديل الكود لكى يضع الدوائر الحمراء فى اماكن محددة فى كل مادة وهى الحصول على درجة الربع  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
قام بنشر
  في 24‏/5‏/2018 at 08:18, ahmedkamelelsayed0 said:

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

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

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

Expand  

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

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

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

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

  • Like 1
قام بنشر (معدل)

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

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

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

تم تعديل بواسطه ahmedkamelelsayed0
  • Thanks 1
قام بنشر
  في 26‏/5‏/2018 at 12:04, ali mohamed ali said:

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

Data Validation

 بارك الله فيك

Expand  

 

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

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

 

 

قام بنشر (معدل)

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

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
قام بنشر
  في 23‏/5‏/2018 at 00:53, ahmedkamelelsayed0 said:

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

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

ونفع بكم

Expand  

 

 

 

  في 23‏/5‏/2018 at 00:53, ahmedkamelelsayed0 said:

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

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

 

Expand  

 

 

 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information