المساعدة في كود الدوائر الحمراء

[kartoti]

تحية أخوية الى جميع الاعضاء. طلبي هو ادراج في الملف المرفق كود الدوائر الحمراء فوق مجموع نقط التلميذ الدي لم يحصل على العتبة في جميع السطور التي به مجموع نقط معين. في الورقات 6 للملف.ولكم جزيل الشكر

تحية أخوية الى جميع الاعضاء. طلبي هو ادراج في الملف المرفق كود الدوائر الحمراء فوق مجموع نقط التلميذ الدي لم يحصل على العتبة في جميع السطور التي به مجموع نقط معين. في الورقات 6 للملف.ولكم جزيل الشكر

 

شبكة.rar

[kartoti]

سلام الامر هام .هل من خبير لعمل المطلوب

[kartoti]

كود رائع تقدمه شركة ميكروسفت يعمل ما كنت ابحث عنه .اولا يجب عمل الدوائر الحمراء من validation des donnes ثم entourer les les donner non valide .بعد ذلك ننتقل الى محرر الاكواد ونقوم بادراج موديل ونضع فيه الكود التالي انه رائع يمكننا من طبع الدوائر

 Sub AddValidationCirclesForPrinting()

    Dim DataRange As Range
    Dim c As Range
    Dim count As Integer
    Dim o As Shape

    'Set an object variable to all of the cells on the active
    'sheet that have data validation -- if an error occurs, run
    'the error handler and end the procedure
    On Error GoTo errhandler
    Set DataRange = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo 0
 
    count = 0
 
    'Loop through each cell that has data validation
    For Each c In DataRange
 
       'If the validation value for the cell is false, then draw
       'a circle around the cell. Set the circle's fill to
       'invisible, the line color to red and the line weight to
       '1.25
       If Not c.Validation.Value Then
           Set o = ActiveSheet.Shapes.AddShape(msoShapeOval, _
               c.Left - 2, c.Top - 2, c.Width + 4, c.Height + 4)
           o.Fill.Visible = msoFalse
           o.Line.ForeColor.SchemeColor = 10
           o.Line.Weight = 1.25
 
           'Change the name of the shape to InvalidData_ + count
           count = count + 1
           o.Name = "InvalidData_" & count
       End If

   Next
   Exit Sub
 
 errhandler:

   MsgBox "There are no cells with data validation on this sheet."

 
 End Sub

 Sub RemoveValidationCircles()
 

    Dim shp As Shape

    'Remove each shape on the active sheet that has a name starting
    'with InvalidData_

    For Each shp In ActiveSheet.Shapes
       If shp.Name Like "InvalidData_*" Then shp.Delete
    Next
 
 End Sub