اذهب الي المحتوي
أوفيسنا

عبدالله باقشير

المشرفين السابقين
 عرض الملف الشخصي  عرض المشاركات

  • Posts

    4796

  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    57

 نوع المحتوي 

كل منشورات العضو عبدالله باقشير

  1. عبدالله باقشير
    السلام عليكم =SUMIF($C$3:$AP$3;"نعم";C4:AP4)
  2. عبدالله باقشير
    السلام عليكم بعد اذن اخي الحبيب احمد اثراءا للموضوع Private Sub Worksheet_Change(ByVal Target As Range) Dim ib As Boolean If Not Intersect(Target, [D6]) Is Nothing Then Application.ScreenUpdating = False If Target.Value = "English" Then ib = True Else ib = False Sheets("Arabic").Visible = Not ib Sheets("English").Visible = ib Me.Shapes("Rectangle 1").Visible = Not ib Me.Shapes("Rectangle 2").Visible = ib Application.ScreenUpdating = True End If End Sub المرفق 2010 Visible.rar
  3. عبدالله باقشير
    السلام عليكم ورحمة الله وبركاته جزاكم الله خيرا واثابكم بدعائكم واعطاكم بمثله اضعاف مضاعفة تقبلوا تحياتي وشكري
  4. عبدالله باقشير
    السلام عليكم بعد اذن اخي الحبيب ابو حنين هذا الكود اعددته مع المسح والفرز للجداول يجب تنفيذ الكود من الورقة (الاسماء حسب القصول) Sub kh_trheel() Dim cel As Range Dim Lr As Long, Lrr As Long, R As Long, i As Long, iCont As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Lrr = Cells(Rows.Count, "C").End(xlUp).Row With Sheets("المنقولين من المدرسة") Lr = .Cells(Rows.Count, "B").End(xlUp).Row iCont = WorksheetFunction.Max(.Range("A5").Resize(Lr)) For R = 5 To Lrr If Cells(R, "U").Value = "نقل" Then i = i + 1 .Cells(Lr + i, "A").Value = iCont + i .Cells(Lr + i, "B").Resize(1, 8).Value = Cells(R, "B").Resize(1, 8).Value If cel Is Nothing Then Set cel = Cells(R, "A").Resize(1, 23) Else Set cel = Union(cel, Cells(R, "A").Resize(1, 23)) End If Next End With If i Then On Error Resume Next cel.SpecialCells(xlCellTypeConstants).ClearContents On Error GoTo 0 For R = 5 To Lrr Step 53 With Cells(R, "A").Resize(50, 23) .Sort .Columns(3), xlAscending End With Next End If Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Set cel = Nothing End Sub تحياتي
  5. عبدالله باقشير
    جزاكم الله خيرا تقبلوا تحياتي وشكري
  6. عبدالله باقشير
    السلام عليكم Private Sub Worksheet_Change(ByVal Target As Range) Dim cel As Range If Target.Cells.Count <> 1 Then Exit Sub If Trim(Target) = "" Then Exit Sub If Not Intersect(Target, Range("B10:F17")) Is Nothing Then For Each cel In Cells(Target.Row, "B").Resize(1, 5) If cel.Address <> Target.Address Then cel.ClearContents Next End If End Sub شاهد المرفق 2010 go.rar
  7. عبدالله باقشير
    السلام عليكم الف مليووووووووووووووووووووون مبروك والى الامام دوماً.... تقبلوا تحياتي وشكري
  8. عبدالله باقشير
    السلام عليكم جرب الكود التالي Sub Macro1() Dim i As Integer Dim ib As Boolean With Worksheets For i = 1 To .Count ib = WorksheetFunction.CountIf(Range("A3:A100"), i) If ib Then .Item(i).Visible = 0 Else .Item(i).Visible = -1 Next End With End Sub المرفق 2010 أوراق.rar
  9. عبدالله باقشير
    السلام عليكم اضف هذا الكود الى الفورم Private Sub ComboBox1_AfterUpdate() If Me.CmbSheet.ListIndex <> -1 Then ComboBox1_Click End Sub تحياتي
  10. عبدالله باقشير
    السلام عليكم في مثل هذه الاكواد يتم في البداية مسح المكان الذي تنتقل الية القيم ثم يتم تنفيذ عملية البحث فان وجدت نتائج للبحث وضعت في المكان او سيبقى المكان ممسوحا كما هو. تحياتي
  11. عبدالله باقشير
    أكرمكم الله في الدارين وجزاكم خيرا تقبلوا تحياتي وشكري
  12. عبدالله باقشير
    جزاكم الله خيرا واثابكم بدعائكم واعطاكم بمثله أضعاف مضاعفة تقبلوا تحياتي وشكري
  13. عبدالله باقشير
    اكرمكم الله في الدارين و جزاكم الله خيرا تقبلوا تحياتي وشكري
  14. عبدالله باقشير
    جزاكم الله خيرا تقبلوا تحياتي وشكري
  15. عبدالله باقشير
    الملف قديم جدا وقد يكون فيه بعض السهو جزاكم الله خيرا تقبلوا تحياتي وشكري
  16. عبدالله باقشير
    جزاكم الله خيرا تقبلوا تحياتي وشكري
  17. عبدالله باقشير
    جزاكم الله خيرا تقبلوا تحياتي وشكري
  18. عبدالله باقشير
    الملف قديم جدا ومصصم على اكسل 2003 الذي لا يوجد فيه تنسيق ام القرى جزاكم الله خيرا تقبلوا تحياتي وشكري
  19. عبدالله باقشير
    جزاكم الله خيرا تقبلوا تحياتي وشكري
  20. عبدالله باقشير
    جزاكم الله خيرا تقبلوا تحياتي وشكري
  21. عبدالله باقشير
    جزاكم الله خيرا تقبلوا تحياتي وشكري
  22. عبدالله باقشير
    جزاكم الله خيرا تقبلوا تحياتي وشكري
  23. عبدالله باقشير
    جزاكم الله خيرا تقبلوا تحياتي وشكري
  24. عبدالله باقشير
    السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري
  25. عبدالله باقشير
    السلام عليكم شاهد الرابط التالي http://www.officena.net/ib/index.php?showtopic=50643
×
×
  • اضف...

Important Information

  I accept