تعديل كود وضع دائرة

[عطية23]

المطلوب تعديل على هذا الكود والكود للاستاذ جلال محمد 

المطلوب هو تحديد الخلايا المراد وضع خلايا عليها اي ان اكتب انا في تكست او خلافه الخلايا b6 ,g8 ,e3 f5 وهكذا ويقوم البرنامج بوضع خلايا حولها مرة واحدة المطلوب عدد كبير من الخلايا لا يقل عن 35 خلية ولكم الشكر

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, G As Integer, R As Integer, d As Integer
'================================================
G = 1      '    عمود رقم الجلوس
R = 15       '    صف الدرجات
Set MyRng = Range("e16:q6000")  ' نطاق الخلايا الذي تريد اضافة الدوائر فيها
'================================================
X = ActiveWindow.Zoom
Application.ScreenUpdating = False
ActiveWindow.Zoom = 100
For Each c In MyRng
    If Cells(c.Row, G) = 0 Or Cells(c.Row, G) = "" Then GoTo 1
    If IsNumeric(Cells(R, c.Column)) And Not IsEmpty(Cells(R, c.Column)) And (c.Value < Cells(R, c.Column) Or c.Value = "غ" Or c.Value = "غـ") 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

 

[محمد يوسف ابو يوسف]

السلام عليكم

اخي عطية23

ممكن بعد اذنك

الملف المراد العمل عليه

وشرح المطلوب داخله

لكي يتم المساعدة 

 

[عطية23]

السلام عليكم ورحمة الله وبركاته

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

حصص زائدة الاول والثانى22.xlsm