[موضوع مميز]شرح عمل شيت كنترول ( درة أعمال العلامة عبد الله باقشير)[مثبت]

Sub اضافة_حذف()
On Error Resume Next
Dim XX As Shape
Set XX = ورقة3.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
Dim V As Shape
Dim X As Integer
Dim G As Integer, R As Integer
'================================================
'    عمود رقم الجلوس
G = 2
'    صف الدرجات
R = 12
' نطاق الخلايا الذي تريد اضافة الدوائر فيها
Set MyRng = Range("N13:BQ47")
'=================================================
' اذا كانت النطاقات مختلفة يمكنك الاشارة اليهم بالتالي
'Set MyRng = Range("O13:O47,Q13:Q47,S13:S47")
'=================================================
X = ActiveWindow.Zoom
Application.ScreenUpdating = False
ActiveWindow.Zoom = 100
For Each C In MyRng
    If Cells(C.Row, G) = 0 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 = "غـ") 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 = 1.25
    End If
1 Next
ActiveWindow.Zoom = X
Application.ScreenUpdating = True
End Sub
Sub RemoveCircles1()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
      If shp.AutoShapeType = msoShapeOval Then shp.Delete
    Next shp
End Sub

دعوة طيبه لوحه الله لكل من ساهم في هذا العمل

اضافة و حذف دوائر_2.rar

**ناصر سعيد** · مايو 26, 2015

تقييد الخلايا بارقام معينه في وجود حرف ال غ

حاول ان تكتب في العمود الملون باللون الاصفر

=OR(AND(D6>=1;D6<=10);D6="غ";D6="غـ";D6="غايب")

**ناصر سعيد** · مايو 26, 2015

مرفق اخر لنفس الموضوع بمعادله اخرى

=DCOUNTA(البيانات;1;معيار2)

=SUMPRODUCT((INDEX(البيانات;0;2)=B21)*(INDEX(البيانات;0;3)=C21)*(INDEX(البيانات;0;5)=D21))

احصائيات.rar

**ناصر سعيد** · مايو 26, 2015

فرز لجدول كامل انت تحدده وبعلوميه اي عمود تبغاه

فرز راائع.rar

**ناصر سعيد** · مايو 26, 2015

Option Explicit
Sub SortTable()

  'code written by Dave Peterson 2005-10-22
  Dim myTable As Range
  Dim myColToSort As Long
  Dim curWks As Worksheet
  Dim mySortOrder As Long
  Dim LastRow As Long
  Dim iCol As Integer
  Dim strCol As String
  iCol = 20  '10 columns
  strCol = "b"  ' column to check for last row

  Set curWks = ActiveSheet
  With curWks
    myColToSort = .Shapes(Application.Caller).TopLeftCell.Column
    LastRow = .Cells(.Rows.Count, strCol).End(xlUp).Row
    Set myTable = .Range("a6:a" & LastRow).Resize(, iCol)
    If .Cells(myTable.Row + 1, myColToSort).Value _
      < .Cells(LastRow, myColToSort).Value Then
        mySortOrder = xlDescending
    Else
        mySortOrder = xlAscending
    End If
    myTable.Sort key1:=.Cells(myTable.Row, myColToSort), _
              order1:=mySortOrder, _
              header:=xlYes
  End With

End Sub

كود المرفق السابق

**ناصر سعيد** · مايو 26, 2015

كيفية ترتيب تقديرات الطلاب

وماشابهها

للعلامة ياقشير اعزه الله

ترتيب مجموعات.rar

**ناصر سعيد** · مايو 26, 2015

ملف بحث في عدة اوراق

للعلامة عبد الله باقشير أعزه الله

بحث و استيراد بيانات من ملف.rar 134.35كيلو 0 عدد مرات التحميل

خيثر يعقوب · يونيو 2, 2015

السلام عليكم ورحمة الله و بركاته أسأل الله الكريم أن يجازي خيرا كل من يسعى لخدمة إخوانه .

تسجيل الدخول

[موضوع مميز]شرح عمل شيت كنترول ( درة أعمال العلامة عبد الله باقشير)[مثبت]

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

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

محمدي عبد السميع

محمدي عبد السميع

قصي

Posted Images

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

Important Information