اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

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

  • Posts

    4796

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

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

  • Days Won

    57

 نوع المحتوي 

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

  1. عبدالله باقشير
    جزاكم الله خيرا تقبلوا تحياتي وشكري
  2. عبدالله باقشير
    اسعدني كثيرا مروركم الطيب وكلماتكم الطيبة جزاكم الله خيرا تقبلوا تحياتي وشكري
  3. عبدالله باقشير
    اسعدني كثيرا مروركم الطيب وكلماتكم الطيبة جزاكم الله خيرا تقبلوا تحياتي وشكري
  4. عبدالله باقشير
    في كود اظهار الفورم اجعله ياخذ اسم الورقة من الخلية الي فيها القائمة مثلا الخلية B5 .kh_SetAddrss CStr(Range("B5")), "C10:AO10" تحياتي
  5. عبدالله باقشير
    اسعدني كثيرا مروركم الطيب وكلماتكم الطيبة جزاكم الله خيرا تقبلوا تحياتي وشكري
  6. عبدالله باقشير
    جزاكم الله خيرا ضع هذا السطر بداية اونهاية الكود UserForm_Activate Me.Caption = MyRngdate.Worksheet.Name في كود اظهار الفورم غير اسم الورقة بالتعبير ActiveSheet.Nam مثلا .kh_SetAddrss ActiveSheet.Name, "C10:AO10" هذا لم افهمه وضح اكثر تقبلوا تحياتي وشكري
  7. عبدالله باقشير
    ان شاء الله تقبلوا تحياتي وشكري
  8. عبدالله باقشير
    جزاكم الله خيرا تقبلوا تحياتي وشكري
  9. عبدالله باقشير
    جزاكم الله خيرا موضوع الجداول مكتمل على ما اعتقد تقبلوا تحياتي وشكري
  10. عبدالله باقشير
    جزاكم الله خيرا تقبلوا تحياتي وشكري
  11. عبدالله باقشير
    السلام عليكم اخي الحبيب / طارق محمود ----- حفظكم ربي الله ينور وجهك في الدنيا والآخرة وجزاكم خيرا تقبلوا تحياتي وشكري
  12. عبدالله باقشير
    السلام عليكم تم استخدام الكود التالي Option Explicit Private Const ContColmn As Integer = 3 '====================================================== '====================================================== Sub kh_Report() Dim obj As Object Dim x(), AryList() Dim iKey As String Dim iTm As Range, Rng As Range Dim LastRow As Long, iCont As Long Dim i As Long, ii As Long, iii As Long Dim c As Integer Dim v1 As Double, v2 As Double '============================================ Set obj = CreateObject("Scripting.Dictionary") '============================================ With Cells.Worksheet LastRow = .Cells(Rows.Count, "B").End(xlUp).Row With .Range("B4") .Activate .Resize(1, ContColmn).ClearContents .Offset(1, 0).Resize(LastRow, ContColmn).Clear End With End With '============================================ With ورقة2 LastRow = .Cells(Rows.Count, "C").End(xlUp).Row Set Rng = .Range("C3:C" & LastRow) End With '============================================ On Error GoTo kh_Ex '============================================ For Each iTm In Rng If CStr(iTm.Cells(1, 3)) = CStr(Range("C2")) Then iKey = iTm.Value v1 = Val(iTm.Cells(1, 4)) v2 = Val(iTm.Cells(1, 2)) ''''''''''''''''''' If obj.exists(iKey) Then iii = obj(iKey) '''''''''''''''''' x(2, iii) = Val(x(2, iii)) + v1 x(3, iii) = Val(x(3, iii)) + v2 Else ii = ii + 1 ReDim Preserve x(1 To ContColmn, 1 To ii) obj.Add iKey, ii '''''''''''''''''' x(1, ii) = iKey x(2, ii) = v1 x(3, ii) = v2 End If End If Next '============================================ iCont = obj.Count If iCont Then ReDim AryList(1 To iCont, 1 To ContColmn) For i = 1 To iCont '''''''''''''''''' For c = 1 To 3 AryList(i, c) = x(c, i) Next '''''''''''''''''' Next '============================================ With Range("B4").Resize(iCont, ContColmn) If iCont > 1 Then .Rows(1).AutoFill .Cells, xlFillFormats .Value = AryList End With ''''''''''''''''''''''''' End If '============================================ kh_Ex: '''''''''''''''''' If Err Then MsgBox "Err.Number : " & Err.Number Err.Clear Else If iCont Then MsgBox "تم تحديث التقرير بنجاح ", vbMsgBoxRight, "الحمدلله" End If '''''''''''''''''' Set obj = Nothing Set Rng = Nothing Erase x, AryList '''''''''''''''''' End Sub شاهد المرفق 2003 تصفية وتجميع.rar
  13. عبدالله باقشير
    جزاكم الله خيرا تقبلوا تحياتي وشكري
  14. عبدالله باقشير
    السلام عليكم جزاكم الله خيرا في كود اظهار الفورم تحدد اسم الورقة ونطاق رؤوس الاعمدة كما اوردت في الشرح Option Explicit '====================================================== '====================================================== ' kh_SetAddrss متغيرات ' ( اولا : اسم ورقة البيانات (افتراضي ' ( ثانيا : نطاق صف رؤوس اعمدة البيانات (افتراضي ''''''''''''''''''''''''''''''''''''''''''''''''' ' ( ثالثا : عمود التسلسل (اختياري ' اذا اردت ادخال رقم تسلسل البيانات الخاص بالفورم ' تلقائيا في عمود معين سجل عنوان راس العمود '====================================================== '====================================================== Sub kh_Show_UFormChang1() On Error GoTo 1 With UFormChang .kh_SetAddrss "مثال1", "C10:AO10" .Show End With 1: If Err Then MsgBox "تاكد من صحة ادخال المتغيرات الاساسية في : " & vbCr & vbCr & "kh_SetAddrss", vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "استخدام خاطىء" On Error GoTo 0 End Sub تم تصحيح الخطا واستبدال المرفق في المشاركة الاولى تقبلوا تحياتي وشكري
  15. عبدالله باقشير
    الحمد لله انه وافق طلبك بالنسبة للقائمة اما طلبك (ليبل عدد نتائج البحث )تجده في المرفق تقبلوا تحياتي وشكري فورم ادخال و تعديل مرن باستخدام اسم نطاق للقائمة.rar
  16. عبدالله باقشير
    جزاكم الله خيرا تقبلوا تحياتي وشكري
  17. عبدالله باقشير
    جزاكم الله خيرا تقبلوا تحياتي وشكري
  18. عبدالله باقشير
    السلام عليكم Sub Macro1() Dim LR As Long, R As Long LR = Cells(Rows.Count, "A").End(xlUp).Row For R = 1 To LR If Cells(R, "A").HasFormula Then Cells(R, "B").Value = "Y" Else Cells(R, "B").Value = "N" End If Next End Sub تحياتي
  19. عبدالله باقشير
    السلام عليكم فورم ادخال و تعديل وبحث باستخدام اسم نطاق للقائمة المنسدلة هو تفس الفورم السابق ولكن تم تغيير طريقة ادخال القائمة المنسدلة لاي عمود في الفورم تستطيع اضافة قائمة لعمود معين في الفورم باضافة تعليق على عنوان العمود وتكتب اسم نطاق القائمة وايضا تم تجاوز بعض الاخطاء في الفورم السابق شرح امكانيات الفورم وكيفية الاستخدام 1 - استخدام الفورم لاكثر من قاعدة بيانات في الورقة الواحدة او في المصنف على ان يكون لكل قاعدة كود لاظهار الفورم يتغير فيه معطياتك في متغيرات kh_SetAddrss اولاً : اسم ورقة البيانات ( افتراضي ) ثانياً : نطاق صف رؤوس اعمدة البيانات ( افتراضي ) ثالثاً : عمود التسلسل ( اختياري ) اذا اردت ادخال رقم تسلسل البيانات الخاص بالفورم تلقائيا في عمود معين سجل عنوان راس العمود . مع ملاحظة انه لا يكون من ضمن نطاق رؤوس اعمدة البيانات كما هو معمول في المثال 2. 2 - تستطيع اضافة قائمة لعمود معين في الفورم باضافة تعليق على عنوان العمود وتكتب اسم نطاق القائمة . 3 - ينسخ التنسيقات والمعادلات في السجل الجديد . 4 - يبحث في جميع الاعمدة حسب الاختيار من القائمة في الفورم . 5 - يعطي نتائج صحيحة عند البحث عن تاريخ اذا شيكت الزر البحث عن تاريخ . 6 - امكانيات زر البحث عن تاريخ يتم تحويل اي قيمة تضعها في مربع النص للبحث الى تاريخ بالتنسيق الافتراضي للفورم ,, مع امكانية ادخال رقم صحيح بين 1 الى 31 ليفهم على انه تاريخ اليوم للشهر الحالي والسنة الحالية 7 - ثوابت بامكانك تغييرها حسب طلبك بداية اكواد الفورم 1- تغيير تنسيقات إظهار التاريخ في الفورم في الثابت DtF 2- تغيير عٌرض مربعات الادخال في الثابت iWgt1 8 - بامكانك انتقاء الاعمدة التي تريدها عند تسمية النطاق وترتيبها حسب ما تريد مع ملاحظة ان العمود الذي يعتمد عليه في احتساب آخر صف هو العمود الاول من التسمية مثلا "E15,C15,H15:AX15" المرفق 2003 [فورم ادخال و تعديل مرن باستخدام اسم نطاق للقائمة.rar الاصدار الثالث: http://www.officena.net/ib/index.php?showtopic=51955
  20. عبدالله باقشير
    اسعدني مروركم الطيب جزاكم الله خيرا تقبلوا تحياتي وشكري
  21. عبدالله باقشير
    جزاكم الله خيرا تقبلوا تحياتي وشكري
  22. عبدالله باقشير
    السلام عليكم لا استطيع في الوقت الراهن التعديل على الملف تقبلوا اعتذاري وتحياتي وشكري
  23. عبدالله باقشير
    تقبلوا تحياتي وشكري
  24. عبدالله باقشير
    جزاكم الله خيرا وكل عام و انتم بخير تقبلوا تحياتي وشكري
  25. عبدالله باقشير
    وعليكم السلام جزاكم الله خيرا غير الكود بهذا Sub Kh_Start() On Error Resume Next Dim MyRang As Range Dim LastRow As Integer, M As Integer, R As Integer, C As Integer '=========================================== 'عدد صفوف القيد المرحل زايداً فارق الصفوف في الورقةوهي 10 صفوف M = Application.CountA([B11:B39]) + 10 '=========================================== 'تجميع الخلايا الغير منتظمة في نساق واحد Set MyRang = Range("B2,B3,A11,B4,B5,B6,B7") '=========================================== 'اذا كان القيد غير متوازن لا يتم الترحيل If Range("D41").Value = False Then MsgBox "القيد غير متوازن", 524288, "تنبيه": GoTo 1 '=========================================== 'تاكيد الاستمرار في الترحيل If MsgBox("هل تريد الاستمرار في ترحيل القيد رقم : " & [B2], 4 + 32 + 524288 + 1048576, "تأكيد الترحيل") = 7 Then GoTo 1 '=========================================== With ورقة11 '=========================================== 'اذا كانت آخر خلية في العمود الثالث في اليومية التحليلية 'اصغر من 6 يبدا من الصف رقم 6 والا يعتمد آخر صف بزيادة صف واحد If .Cells(5997, 3).End(xlUp).Row < 6 Then LastRow = 6 _ Else LastRow = .Cells(5997, 3).End(xlUp).Row + 1 '=========================================== Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For C = 1 To 7 .Cells(LastRow, C + 2) = MyRang.Areas(C) Next For R = 11 To M If Len(.Cells(LastRow, 10)) Then GoTo 10 If Application.CountA([D11:D39]) > 1 Then .Cells(LastRow, 10) = "مذكورين": GoTo 10 If Val(Cells(R, 4)) Then .Cells(LastRow, 10) = Cells(R, 2) 10 If Len(.Cells(LastRow, 11)) Then GoTo 20 If Application.CountA([E11:E39]) > 1 Then .Cells(LastRow, 11) = "مذكورين": GoTo 20 If Val(Cells(R, 5)) Then .Cells(LastRow, 11) = Cells(R, 2) 20 If Cells(R, 3) <> "" Then .Cells(LastRow, 20) = Cells(R, 3).Value If Cells(R, 4) <> "" Then .Cells(LastRow, Cells(R, 8).Value).Value = Cells(R, 4).Value If Cells(R, 5) <> "" Then .Cells(LastRow, Cells(R, 8).Value + 1).Value = Cells(R, 5).Value Next R With .Range("C6:CJ5997") .Sort .Columns(2), xlAscending, .Columns(1), , xlAscending End With End With Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "تم الترحيل بنجاح", 524288, "الحمد لله" '=========================================== 'امسح الخلايا المنقولة اذا اردت ذلك Range("B2:B6,B7").ClearContents Range("A11:E39").ClearContents '=========================================== On Error GoTo 0 1 End Sub تحياتي
×
×
  • اضف...

Important Information

  I accept