الكود يعمل جيدا ولكن لي سوال مالفرق بين هذا الكود وكود العلامه للدوائر الحمرا القديم
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 = 2 ' عمود رقم الجلوس
R = 11 ' صف الدرجات
Set MyRng = Range("l9:dn500") ' نطاق الخلايا الذي تريد اضافة الدوائر فيها
'================================================
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
طباعة1.rar