نجوم المشاركات

أخي الغالي جلال الجمال لا تحزن ..إن فرج الله قريب .. وما علينا إلا أن نزرع أما الحصاد فبالتأكيد له أوانه .. افعل ما يجب عليك فعله فلربما يأتي اليوم الذي يحتاج إليه أناس آخرون ما نقدمه .. فيتركوا لنا دعوة بظهر الغيب .. وما أجملها من دعوة من شخص لا تعرفه في زمان لا تعرفه في وقت وأجل لا تعرفه ، ومن يدري لعلها تخفف عنا أخي الحبيب أبو حنين وجزيت خيراً بمثل ما دعوت لي ولك بمثل إن شاء الله .. والحمد لله أن نال الشرح إعجابكم ، وإن كان الشرح لا يجدي مع الأكواد التي تتعامل بالمصفوفات إذ أنه يجب الشرح بشكل مباشر دون الكتابة ، ولكن حاولت أن أضع الخطوط العريضة ليتمكن الأخوة من تعلم التعامل مع المصفوفات تقبلوا وافر تقديري واحترامي

انظر داخل الكود في المثال ستجد السطر المسؤول عن تخصيص الملفات المعروضة strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls") لا حظ انه حدد نوع الملفات عدل عليه كما تريد ، انظر السطر هذا اضفت اليه قواعد بيانات اكسس AddFilterItem(strFilter, "Excel and access Files (*.xls), *.xls, *.mdb") او تدري عن شي احسن من كل هذا : افتح اي شيء انظر السطر strFilter = ahtAddFilterItem(strFilter, "any Files (*.*)")

وعليكم السلام هو في حد جاب اسمي تفضل ، هذا كود زر فتح التقرير من النموذج Private Sub Command13_Click() 'On Error Resume Next DoCmd.OpenReport "salry3", acViewPreview Dim Filt As Variant If Me.Fr = 1 Then Filt = "[nam] ASC" ElseIf Me.Fr = 2 Then Filt = "[twqe] ASC" ElseIf Me.Fr = 3 Then Filt = "[draga] ASC" End If Reports!salry3.OrderBy = Filt Reports!salry3.OrderByOn = True End Sub في الواقع احنا ما محتاجين وضع امر ASC اي ترتيب تصاعدي ، لأنه الامر الافتراضي ، اذا لم نضع الامر Desc اي ترتيب تنازلي الكود اعلاه ما راح يشتغل في تقريرك ، لأنه عندك فرز في تقريرك (Sorting and Grouping) ، لذا يجب ازالت هذا الفرز اولا. واما اذا اردت الفرز ان يكون بحقلين ، بحيث الفرز الاول يكون للحقل الاول ، والفرز الثاني للحقل الثاني ، مثلا: Names Years 2001 jj 2000 ab 2001 zx 2000 aa فنريد الفرز بالسنة ثم الاسم ، وتكون النتيجة هكذا: 2000 aa 2000 ab 2001 jj 2001 zx فهنا يجب ان يكون الفرز بالحقلين ، ونبدا بحقل السنة ثم الاسم ، فيصبح الكود Filt = "[Years], [names]" ولاحظ اننا لم نستعمل الامر ASC لاننا لسنا بحاجة اليه جعفر

تفضل : كود لكلمة مرور قاعدة بيانات بعيدة يمكنك من خلاله 1-الغاء كلمة المرور 2- تعديل كلمة المرور 3- انشاء كلمة مرور جديدة Private Sub ChangeAccessPassword(OldPass As String, NewPass As String) Dim Db As Database ' opens the databse, using the old password. ' replace "C:\MyDir\Mydb1.mdb" with your database file name Set Db = OpenDatabase("C:\MyDir\Mydb1.mdb", True, False, ";pwd=" & OldPass) ' setthe new password Db.NewPassword OldPass, NewPass ' close the database Db.Close End Sub Private Sub Command1_Click() ' replace "oldPassword" with the current database password, and ' "newPassword" with the new password you want the database will have. Call ChangeAccessPassword("oldPassword", "newPassword") End Sub

السلام عليكم، بعد إذن استاذنا الفاضل ابو البراء، انظر اخي ابو حمزة الى المرفق. SUM_ARRAY_v001.rar

السلام عليكم ورحمة الله وبركاته كود البحث المتقدم باستخدام المصفوفات VBA Arrays قدم لنا الأخ الغالي ياسر العربي صاحب الجولات والصولات كود رائع ، ويستخدم الكود في البحث المتقدم ، وقد استخدم المصفوفات والتي هي عشقي في التعامل مع الأكواد ، حيث يتم تنفيذ جميع أسطر الكود بالذاكرة بعيداً عن التعامل بشكل مباشر مع ورقة العمل ، مما يجعل الكود أسرع مئات المرات من استخدام الحلقات التكرارية العادية. وقد ارتأيت أن أقوم بشرح لأسطر الكود ليكون مرجع لكل طالب علم ولكل باحث في هذا الخصوص ، ولنبدأ مرحلة جديدة من عالم الأكواد باستخدام المصفوفات VBA Arrays ، لما لها من مرونة عالية وسرعة فائقة في تنفيذ الأكواد. يوجد بالمرفق ورقتي عمل أحدهما باسم Data وفيها البيانات الخام من 14 عمود ، والورقة الأخرى باسم Result للنتائج وبها الخلية G2 والتي توضع بها نص الكلمة المراد البحث عنها. وإليكم الكود مع الشرح بالتفصيل (وضعت مثال بسيط ليستطيع المتتبع للشرح فهم الكود بسهولة) Sub Araby_Search() 'تعريف المتغير لورقة العمل التي تحتوي على البيانات الخام Dim wsData As Worksheet 'تعريف المتغير لورقة العمـل المطلـوب إظهـار النتائـج بها Dim wsResult As Worksheet 'تعريف المتغير ليحمل قيم المصفـوفة للبيانات الخـام Dim Arr As Variant 'تعريف المتغير ليحمل قيم المصفوفة للنتائج المطلوبة Dim Temp As Variant 'تعريـف المتغير من النـوع النصي ليحمـل قيمة أو نص البحث 'أي الكلمة المطلوب البحث عنها يتم تخزينها في هذا المتغير Dim strSearch As String 'تعريف المتغير وسيستخدم في الحلقة التكرارية لصفوف المصفوفة Dim I As Long 'تعريف المتغير وسيستخدم في الحلقة التكرارية لأعمدة المصفوفة Dim J As Long 'تعريف المتغير وسيستخدم في مصفوفة النتائج لزيادة مقدار الصفوف بمقدار واحد Dim P As Long 'تعيين قيمة للمتغير ليساوي ورقة العمل التي تحتوي '[Data] على البيانات الخام المطلوب معالجتها والمسماة Set wsData = Worksheets("Data") 'تعيين قيمة للمتغير ليساوي ورقة العمل التي تريد إظهار '[G2] النتائج بها بمجرد إدخال قيمة أو نص محدد في الخلية Set wsResult = Worksheets("Result") 'مسح النطاق الذي توضع فيه النتائج استعداداً لوضع النتائج الجديدة wsResult.Range("A8:N10000").ClearContents '[G2] تعيين قيمة للمتغير ليساوي قيمة الخلية 'وهي الخلية التي ستوضع فيها نص الكلمة المطلوب البحث عنها strSearch = wsResult.Range("G2").Value 'تعيين قيمـة للمتغير ليحمل قيم النطاق بالكامل للبيانات الخام ' وذلك [Data] حيث أن مصـدر البيانات الخام ورقة العمل المسماة 'عند [N] وينتهي في العمود [A5] في النطاق الذي يبدأ من الخلية '[&] آخـر صف به بيانات ، ويتم تحديده عن طريـق الجزء بعد علامـة Arr = wsData.Range("A5:N" & wsData.Cells(Rows.Count, 1).End(xlUp).Row).Value 'والتي ستحمل قيم النتائج [Temp] إعادة تعيين أبعاد المصفوفة المسماة '[Arr] وتكون بنفس أبعاد المصفوفة التي تحمل البيانات الخام والمسماة 'سنعتبر المصفوفة أشبـه بالصفـوف والأعمدة حيث الرقـم 1 يمثـل الصفـوف 'بإرجاع أكبر قيمة [UBound]بينما الرقم 2 يمثل الأعمدة ، وتقوم الكلمة 'أبعاد المصفوفة في هذه الحالة >> '------------------------------- 'البعد الأول سيكون من 1 إلى أكبر قيمة للصفوف 'البعد الثاني سيكون من 1 إلى أكبر قيمة للأعمدة ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) 'حلقة تكرارية من الصف الأول للمصفوفة إلى آخر صف بها For I = 1 To UBound(Arr, 1) 'إذا كان النص المطلوب البحث عنه فارغ يتم الخروج من تنفيذ الكود If strSearch = "" Then Exit Sub 'هذا السطر هو أهم سطر بالكود حيث هو الشرط الذي من خلاله 'والشرط [Temp] ستوضع النتائج في مصفوفة النتائج المسماة 'هـو تطابق قيمة المصفوفة في صف الحلقة في العمود رقم 14 'حيث يمثـل الرقم 14 العمود داخـل مصفوفة البيانات الخام '[strSearch] يتـم اختبـار التطابـق مع نـص البحث المسمى If Arr(I, 14) Like "*" & strSearch & "*" Then 'زيادة مقدار المتغير بمقدار 1 'فائدة المتغير هنا هو أنه مع كل حلقة تكرارية 'إذا تحقق الشرط فقط يزيد المتغير بمقدار واحد 'ليمثل هذا المتغير صفوف مصفوفة النتائج الجديدة P = P + 1 'حلقة تكرارية داخلية من العمود الأول للمصفوفة إلى آخر عمود بها For J = 1 To UBound(Arr, 2) 'تعبئـة مصفـوفة النتائـج بالبيانات مـن مصفوفة البيانات الخام '[Temp]مثـال لتتضح صورة كيفية تعبئة المصفوفة الجديدة المسماة 'في أول حلقـة سيكون مقداره 1 ويمثل أول صف [P] المتغيـر المسمى 'أول صف هنا لمصفوفة النتائج 'في أول حلقة سيكون مقداره 1 ويمثل أول عمود [J] المتغير المسمى 'في أول حلقة سيكون مقداره 1 ويمثل أول صف [I] المتغير المسمى 'أول صف هنا لمصفوفة البيانات الخام Temp(P, J) = Arr(I, J) 'الانتقال للحلقة التالية للأعمدة Next J 'نهاية جملة الشرط وهو تطابق نص البحث مع العمود رقم 14 في المصفوفة End If 'الانتقال للحلقة التالية في صفوف مصفوفة البيانات الخام Next I 'إذا كانت قيمة المتغير أكبر من صفر فهذا يعني أنه تم إيجاد نتائج للبحث 'حيث أن زيادة المتغير كما أوضحنا مقرونة بتحقق الشرط وطالما تحقق الشرط 'فهذا يعني أن مصفوفة النتائج سيكون بها بيانات ومن ثم يتحقق الجزء الثاني '[A8] وضع نتائج مصفوفة النتائج في أول خلية في ورقة النتائج في الخلية '[P] ويتم تمديد النطاق بمقدار عدد الصفوف طبقاً لقيمة المتغير المسمى '[Temp] وبمقدار عدد الأعمدة طبقاً لأكبر عدد لأعمدة المصفوفة المسماة If P > 0 Then wsResult.Range("A8").Resize(P, UBound(Temp, 2)).Value = Temp End Sub لتحميل الملف المرفق وللإطلاع على الموضوع الأصلي قم بزيارة الرابط التالي رابط الموضوع من هنا

وعليكم السلام أخي الكريم أبو عبد النور بارك الله فيك على الكود الجميل .. يعيب الكود فقط أنه لابد أن تكون القيم المتشابهة متتالية وإلا لن تكون النتائج صحيحة ... أما الكود الذي قدمته لم أجربه على الملف لكن يعيب أنه لابد من التخلص من المسافات الزائدة لذا وجب إضافة إلى الكود لكي يتلاشى خطأ المسافات والكود بهذا الشكل Sub UniqueListAndSum() Dim ws As Worksheet Dim i As Long Dim j As Long Dim k As Long Dim x, y() ReDim y(1 To Rows.Count, 1 To 2) With CreateObject("Scripting.Dictionary") .CompareMode = 1 Set ws = Sheets("StockReport") x = ws.Range("A1:B" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Value For i = 2 To UBound(x) x(i, 1) = Trim(x(i, 1)) If Len(x(i, 1)) Then If .Exists(x(i, 1)) Then k = .Item(x(i, 1)) y(k, 2) = y(k, 2) + x(i, 2) Else j = j + 1 .Item(x(i, 1)) = j y(j, 1) = x(i, 1) y(j, 2) = x(i, 2) End If End If Next i End With With ws .Columns("I:J").ClearContents .Range("I1:J1") = Array("Names", "Quantity") .Range("I2").Resize(j, 2).Value = y() End With End Sub

عليكم السلام ورحمة الله وبركاته يااستاذ ياسر انا والله بحاول ان اتعلم يعنى بضع ملف صغير غير الاصل وبحاول ان اشغل عقلى شوية وارتب الاكواد علشان ماكنش ثقيل عليكم يعنى بكون عايز اقل جهد من حضراتكم حتى لااحد يمل من طلبى المتكرر ولسيادتكم جذيل الشكر والتقدير .

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

اشكرك جزيلا وجزاك الله خير اخي العزيز اشكرك جزيلا وجزاك الله خير اخي العزيز , و لا في اي شي اخو عزيز وغالي

السلام عليكم، المثال مرة أخرى مرفق مع الشرح. SUM_ARRAY_v001.rar

وعليكم السلام أخي سلمان ، مجتاج معلومات اكثر منك والاهم شوية امثلة من برنامجك ، وخصوصا طريقة الدخول ، وما المعلومات التي تريد ادخالها ، والمعلومات التي تريد استردادها ، ولكن ، هناك امكانية لعمل هذا بوجه عام في معظم المواقع ، ويجب ان نجرب على هذا الموقع بالذات جعفر

السلام عليكم يااستاذ ياسر انا فعلا عاجز عن الشكر والحمدلله كله بقى تمام بفضل ربنا سبحانه وتعالى وحضرتك وبارك الله فيك وجعلك الله دائما فى عون المحتاجين .

شكراً جزيلاً استاذ خالد لقد اصبت الهدف بدقة جزاك الله كل خير وبارك فيك ،،، وتقبل تحياتي

تفضل عزيزي هل هذا هو المطلوب بوماجد2.rar

اتفضل كما تريد تقريب الى اعلى.rar

الاخ احمد الطحان الملف فية مجهود والظاهر ان طلبك فى صفحة الشيت ياريت ترسل ملف بصفحة واحدة وتضع فيها الدرجات وتوضح عيها المطلوب لانى لم اعمل فى الازهر وما قصة الفرق22 ماذا تعنى واين تضع

تحية طيبة اخي الكريم لاظهار القيم في الرسم البياني ادخل الى طريقة عرض التصميم ثم انقر نقرا مزدوجا فوق المخطط ستظهر نافذة جديدة للمخطط انقر بالزر الايمن للفارة فوق المخطط و اختر ( خيارات المخطط ) ثم ( تسمية البيانات ) ثم فعل خيار ( القيمة )

احسنت جزاك الله خيرا وهذا هو الملف للتطبيق عليه ( كما سبق وطلبت ) نموذج حسابات.rar

الاساتذة الكرام انتم تضعون بذور العلم فى ارض الحياه وترتوى بنفحات من افكاركم الجميلة ليتغذى عليها كل جائع والحصاد الحقيقى ليس لمن يتغذى وانما لمن زرع والحصاد بكل حبة عشر امثالها اللهم اجعل هذا العلم نوراً لكل زارع يوم القيامة