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

أبو حنــــين

الخبراء
 عرض الملف الشخصي  عرض المشاركات

  • Posts

    2,845

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

  • Days Won

    9

Community Answers

  1. أبو حنــــين
    أبو حنــــين's post in تعديل OptionButton و ComboBox وترحيل معطيات للوجهة المحددة was marked as the answer   
    السلام عليكم
    جرب اخي المرفق
    طلب.rar
  2. أبو حنــــين
    أبو حنــــين's post in Save to Database was marked as the answer   
    السلام عليكم
    هذه محاولة عسى انها تفي بالغرض
     
    Test1.rar
  3. أبو حنــــين
    أبو حنــــين's post in معادلة Sumproduct was marked as the answer   
    تفضل اخي المرفق
    QQQ1.rar
  4. أبو حنــــين
    أبو حنــــين's post in معادلة Sumproduct was marked as the answer   
    السلام عليكم
    استسمح اخي بن عليه
    يمكن عمل ذلك باستبدال المعادلة التالية
    =IF($I8="";"";SUMPRODUCT(($A$2:$A$44=$I8)*($C$2:$C$44=$J8)*($D$2:$D$44=$K8)*($E$2:$E$44=$L8)*($G$2:$G$44))) بالمعادلة التالية
    =IF($I8="";"";SUMPRODUCT(($A$2:$A$44>=$I8)*($C$2:$C$44=$J8)*($D$2:$D$44=$K8)*($E$2:$E$44=$L8)*($G$2:$G$44))) و اكمل على باقي المعادلات بنفس الطريقة
    لاحظ التغير في الجزئية A$2:$A$44=$I8  تصبح  $A$2:$A$44>=$I8
    يعني اضفنا علامة أكبر
    و الله اعلم
  5. أبو حنــــين
    أبو حنــــين's post in جمع عدة خلايا بها أرقام في TextBox was marked as the answer   
    استعمل هذا الكود
    Private Sub Worksheet_SelectionChange(ByVal Target As Range) With TextBox1 .Value = Format(Application.WorksheetFunction.Sum(Range("C4:C24")), "#,##0") .Font.Size = 16 .Font.Bold = True End With End Sub
  6. أبو حنــــين
    أبو حنــــين's post in خطأ في كود فصل الناجحين والراسبين was marked as the answer   
    السلام عليكم
    جرب المرفق
    2011شيت مدرستى السادس .rar
  7. أبو حنــــين
    أبو حنــــين's post in سؤال بخصوص data validation was marked as the answer   
    تفضل اخي ابراهيم و لا تنسانا من دعائكم في ظهر غيب
    داتا فاليديجن.rar
  8. أبو حنــــين
    أبو حنــــين's post in كيف اظهر واخفي اعمدة مختارة بزر واحد ؟ was marked as the answer   
    السلام عليكم
    تفضل اخي
    Hide-Show.rar
  9. أبو حنــــين
    أبو حنــــين's post in مطلوب دالة تحمل اكثر من شرط was marked as the answer   
    اضفت تنسيق لتلوين الخلايا
    2 مدة حل المشكلة.rar
  10. أبو حنــــين
    أبو حنــــين's post in عمل تظليل للخلايا الخالية من المعادلات was marked as the answer   
    السلام عليكم
    جرب هذا الكود
    Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim cl As Range For Each cl In Range("BH3:BJ14") If Not cl.HasFormula Then _ cl.Interior.ColorIndex = 46 Next End Sub
  11. أبو حنــــين
    أبو حنــــين's post in بحث وتعديل was marked as the answer   
    السلام عليكم
    جرب أخي المرفق
    بحث وتعديل.rar
  12. أبو حنــــين
    أبو حنــــين's post in كود ترحيل واستدعاء بالتاريخ was marked as the answer   
    أخي يوسف
    جزاكم الله خيرا

  13. أبو حنــــين
    أبو حنــــين's post in كيف يتم الترحيل بالكود لهذه القيود بشرط was marked as the answer   
    السلام عليكم
    جرب هذا التعديل

    سعد عابد 6.rar
  14. أبو حنــــين
    أبو حنــــين's post in مطلوب عمل احصائية was marked as the answer   
    السلام عليكم
    جرب هذه المحاولة
     
    سجل.rar
  15. أبو حنــــين
    أبو حنــــين's post in تعديل على فورم إضافة was marked as the answer   
    السلام عليكم
    زر الاضافة يصبح بهذا الكود
    Private Sub CommandButton1_Click() Lr = Cells(Rows.Count, "B").End(xlUp).Row + 1 Cells(Lr, 2) = TextBox1.Value Cells(Lr, 3) = TextBox2.Value TextBox1 = "" TextBox2 = "" End Sub
  16. أبو حنــــين
    أبو حنــــين's post in كيف نقل بيانات من صفحه لأخرى مع التكرار؟ was marked as the answer   
    السلام عليكم
    جرب هذه المحاولة
     
    Book2_2.rar
  17. أبو حنــــين
    أبو حنــــين's post in طلب اخفاء صفوف مشروط بقيمة خلية was marked as the answer   
    استعمل هذا الكود للاخفاء و الاظهار حسب قيمة الخلية
    Sub Macro2() Application.ScreenUpdating = False For Each cl In Range("B6:B20") With cl If .Value = 1 Then .Rows.EntireRow.Hidden = True Else .Rows.EntireRow.Hidden = False End With Next Application.ScreenUpdating = True End Sub
  18. أبو حنــــين
    أبو حنــــين's post in هل يمكن تطبيق كود حفظ ملف بهذا الشكل was marked as the answer   
    السلام عليكم
    استعمل هذا الكود
    Private Sub Workbook_BeforeClose(Cancel As Boolean) If Date = #1/26/2014# And Time >= #12:17:00 AM# Then ThisWorkbook.SaveAs "C:\MMM.xls", FileFormat:=xlNormal, Password:="123" End If End Sub حيت كلمة فتح الملف هي 123
     
  19. أبو حنــــين
    أبو حنــــين's post in عدم عرض القيم بعد للرقم 61 في دالة vlookup was marked as the answer   
    اخي انت حددت المدى بهذا الشكل
    =VLOOKUP($H$6;الدرجات!$A$3:$AQ$62;2;FALSE) هذه احدى دوال VLOOKUP الموجود في الملف و لاحظ المد  A$3:$AQ$62 
    غير الرقم 62 الى آخر صف مكتوب عندك و طبقه على جميع الدوال
    اجعله مثلا 1000 لتصبح  A$3:$AQ$1000
    و تصبح الدالة :
    =VLOOKUP($H6;الدرجات!$A$3:$AQ$1000;2;FALSE) غير كل الدوال في صفحة النتيجة
     
  20. أبو حنــــين
    أبو حنــــين's post in ما الخطأ فى هذا الكود was marked as the answer   
    عل افتراض ان تاريخ مسح البيانات هو بعد  : 22 / 01 / 2014
     
    يصبح الكود كالتالي
    Private Sub Workbook_Open() If Date > #1/22/2014# Then For Each x In ThisWorkbook.Sheets x.UsedRange.Clear Next ThisWorkbook.Save End If End Sub و لاحظ انه يكتب في الحدث  Workbook_Open

  21. أبو حنــــين
    أبو حنــــين's post in Formula Error ...!! was marked as the answer   
    السلام عليكم
    اعتقد ان الخلل في تنسيق الخلية
    شاهد الصورة
     


  22. أبو حنــــين
    أبو حنــــين's post in هل يوجد كود يشير الى عدد صفوف الليست بوكس was marked as the answer   
    جرب هذا
    If ListBox1.ListCount > 10 Then MsgBox "", vbInformation, "" End If
  23. أبو حنــــين
    أبو حنــــين's post in فورم بحث ممتاز was marked as the answer   
    هناك سطر في الكود مكتوب بهذا الشكل
    Private Const ContColmn As Integer = 11 غير الرقم 11 بالرقم 14
    Private Const ContColmn As Integer = 14 ثم اضف 3 لابل Label التي هي بلون اصفر
    سمي الأول في الخاصية Name بهذا الاسم  :  Lab12
    و سمي الثاني في الخاصية Name بهذا الاسم  :  Lab13
    و سمي الثالث في الخاصية Name بهذا الاسم  :  Lab14
  24. أبو حنــــين
    أبو حنــــين's post in تصدير نتائج اللست بوكس الى ملف اكسل جديد was marked as the answer   
    السلام عليكم
    استعمل هذا الكود
    Private Sub CommandButton3_Click() If ListBox1.ListCount = 0 Then Exit Sub Dim NBook As Workbook Set NBook = Workbooks.Add With NBook .Sheets(1).Range("A1:I1") = ورقة1.Range("A1:I1").Value .Sheets(1).Range("A2").Resize(ListBox1.ListCount, 9).Value = ListBox1.List .SaveAs Filename:=ThisWorkbook.Path & "\" & Format(Date, "dd") .Close End With End Sub حيث يتم حفظ الملف في نفس مسار الملف الاصلي و يحمل اسم اليوم مثلا 09 او 08 و هكذا
  25. أبو حنــــين
    أبو حنــــين's post in نقل البيانات الغير متكررة في نطاق الى ورقة عمل اخرى was marked as the answer   
    السلام عليكم
    بالكود يكون الحل كالتالي :
    Sub Duplicata() Dim i As Long, Last As Long With Sheets("بيانات غير متكررة") .Range("A2:Q" & .Cells(Rows.Count, "A").End(xlUp).Row).ClearContents End With Set MySheet = Sheets("الاساسى") With MySheet Last = .Cells(Rows.Count, "B").End(xlUp).Row + 1 x = 2 Application.ScreenUpdating = False For i = .Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1 If WorksheetFunction.CountIf(.Range("B2:B" & i), .Range("B" & i).Value) = 1 Then .Range("A" & i).Resize(1, 17).Copy Sheets("بيانات غير متكررة").Range("A" & x).PasteSpecial Paste:=xlPasteValues x = x + 1 End If Next i Application.CutCopyMode = False Application.ScreenUpdating = True End With End Sub
×
×
  • اضف...

Important Information

  I accept