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

السلام عليكم ورحمة الله اليكم الكود المميز التالى أعتقد أنه للأستاذ عبدالله باقشير صالح للاصدارات الحديثة من 2007 فما فوق يمنع النسخ والقص واللصق من خلال الماوس والكيبورد معا ومن خلاله تستطيع تعطيل و تفعيل النسخ والقص واللصق بالرقم السرى 123 ( يمكن تعديله ) Public xx As Integer Public x As Integer Sub Auto_Open() Application.ScreenUpdating = False Application.DisplayAlerts = False kh_wVisible True Application.ScreenUpdating = False ActiveWindow.DisplayWorkbookTabs = False Application.DisplayFormulaBar = False Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",false)" Call ToggleCutCopyAndPaste(False) Application.ScreenUpdating = True Application.DisplayAlerts = True Application.Calculation = xlCalculationAutomatic End Sub Sub Auto_Close() Application.ScreenUpdating = False Application.DisplayAlerts = False Dim i As Integer kh_wVisible False ThisWorkbook.Close Not CBool(ThisWorkbook.Saved) Application.DisplayFormulaBar = True Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)" Call ToggleCutCopyAndPaste(True) Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub Sub kh_wVisible(ibol As Boolean) Application.ScreenUpdating = False Application.DisplayAlerts = False Dim nBook As String nBook = ThisWorkbook.Name With Windows(nBook) If .Visible = Not ibol Then .Visible = ibol End With Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub Sub EnableCutcopypaste() Application.ScreenUpdating = False Application.DisplayAlerts = False xx: Dim x x = InputBox("لتفعيل النسخ يتطلب" & Chr(13) & "الرجاء ادخال كلمة المرور", "كلمة مرور") If IsNull(x) Or x = "" Then GoTo xx If x = "123" Then Call ToggleCutCopyAndPaste(True) Else MsgBox "كلمة مرور غير صحيحة" & Chr(13) & " الرجاء اعادة ادخال كلمة المرور ", vbOKOnly End If Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub Sub DisableCutcopypaste() Application.ScreenUpdating = False Application.DisplayAlerts = False Call ToggleCutCopyAndPaste(False) Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub Sub ToggleCutCopyAndPaste(Allow As Boolean) Application.ScreenUpdating = False Application.DisplayAlerts = False 'Activate/deactivate cut, copy, paste and pastespecial menu items Call EnableMenuItem(21, Allow) ' cut Call EnableMenuItem(19, Allow) ' copy Call EnableMenuItem(22, Allow) ' paste Call EnableMenuItem(755, Allow) ' pastespecial 'Activate/deactivate drag and drop ability Application.CellDragAndDrop = Allow 'Activate/deactivate cut, copy, paste and pastespecial shortcut keys With Application Select Case Allow Case Is = False .OnKey "^c", "CutCopyPasteDisabled" .OnKey "^v", "CutCopyPasteDisabled" .OnKey "^x", "CutCopyPasteDisabled" .OnKey "+{DEL}", "CutCopyPasteDisabled" .OnKey "^{INSERT}", "CutCopyPasteDisabled" Case Is = True .OnKey "^c" .OnKey "^v" .OnKey "^x" .OnKey "+{DEL}" .OnKey "^{INSERT}" End Select End With Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean) Application.ScreenUpdating = False Application.DisplayAlerts = False 'Activate/Deactivate specific menu item Dim cBar As CommandBar Dim cBarCtrl As CommandBarControl For Each cBar In Application.CommandBars If cBar.Name <> "Clipboard" Then Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True) If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled End If Next Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub Sub CutCopyPasteDisabled() Application.ScreenUpdating = False Application.DisplayAlerts = False 'Inform user that the functions have been disabled MsgBox "نأسف تم تعطيل النسخ والقص واللصق فى هذا الملف!" Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub المرفق Disable Enable Cut copy paste .rar

الأعضاء الأعزاء أسعد الله أوقاتكم بكل خير يسرني إعلامكم بأنني سأقوم قريباً برفع ملفات الفيديو الخاصة بالدورة المميزة والأولى على مستوى المنتديات العربية: إكسيل 2013 المستوى المتقدم حيث ستكون هذه الدورة استكمالاً لدورتنا السابقة " مهارات الاستخدام الفعال لبرنامج اكسيل 2013" والتي سوف تجدونها على الرابط التالي: https://www.youtube.com/watch?v=T7XFV5YnnUk&list=PLPoNGHomnbeXAKxx955de2LObBbofdfWx وسوف تحتوي هذه الدورة على أكثر من 35 درس فيديو عالي الجودة تغطي العديد من المواضيع المتقدمة والمتقدمة جداً. الخطوط العريضة لهذه الدورة هي كما في الصورة المرفقة. http://www.mrkzgulf.com/do.php?img=67347 فانتظرونا......... أخوكم م/نضال الشامي Google+ Twitter

أبدأ بحمد الله أولا وأخيرا على ما انعم ووفق وأصلي واسلم على الرحمة المهداة والسراج المنير نبينا محمد وعلى آله وصحبه وسلم ... وبعد كل عام وأنتم بخير وأعاد الله علينا أيامه الكريمة بالخير واليمن والبركات في موضوع اخي الكريم ابو عبدالرحمن وطلبه لواجهة برنامج لتسجيل الأطفال لرياض الاطفال او الروضة علي هذا الرابط فضلت ان تكون في مشاركة منفصلة لتعميم الفائدة ان شاء الله تعالى بشكل بسيط وجذاب صدقة جارية لفارس من فرسان منتدانا أوفيسنا أخي ومعلمنا عماد الحسامي رحمة الله عليه ورحم جميع المسلمين وغفر لهم الأحياء منهم والأموات حتي لا أطيل عليكم شرح مبسط للبرنامج أترككم لتجربة البرنامج في المرفقات وارحب بمشاركتكم في اجراء اية تعديلات وفقنا الله واياكم للصالحات مع تحياتي // ضاحي الغريب KG_Dahy.rar الان الاصدار الثاني علي الرابط التالي اضغط هنا

اخفاء ازرار الصفحات ActiveWindow.DisplayWorkbookTabs = False اخفاء شريط القوائم العلوي Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",false)" اخفاء شريط المعادلات Application.DisplayFormulaBar = False ولاعادة اظهارهم يتم استبدال كلمة false بكلمة True

الاخت الفاضله شاهدى المرفق شرائح.zip

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

السلام عليكم ورحمة الله وبركاته أضع بين يدي أخوتي الكرام في هذا المنتدى الأغر ملف رائع حصلت عليه به شرح لجميع دوال إكسل (حوالي 340 دالة) مع رابط لكل دالة لشرح أكثر من موقع مايكروسوفت worksheet functions.rar

الحمد لله رب العالمين و بفضل من الله ثم رضا الوالدين و بفضل هذا المنتدى و المنتديات العربية و العالمية الأخرى المتخصصة في مجال الإكسيل, حصلت على شهادة MVP Most Valuable Professional و لله الحمد أني كا أول عربي حصل عليها و أسأل الله العلي القدير أن تكون بداية توفيق جديد لنا و أنا نخدم الأمة و أن ننفع بها أهلنا و أمتنا لله الحمد من قبل و من بعد

انا لله و انا اليه راجعون اللهم اغفر له و ارحمه و عافه و اعف عنه و اكرم نزله و وسع مدخله و اجعل قبره روضه من رياض الجنه و اغسله من خطاياه بالماء و الثلج و البرد اللهم عامله بما انت اهله فانت يا مولنا اهل التقوى و المغفر

اعزائي اليكم هذا السطرالواحد من الكود والذي يقوم بفتح مربع حوار سحب الصور من الاسكنر وحفظ الصورة في نفس مسار برنامجك الاكسس ! Set img = CreateObject("wia.commondialog").ShowAcquireImage.SaveFile(CurrentProject.Path & "\" & InputBox("ادخل اسم الصورة") & ".jpg") تحياتي

السلام عليكم ورحمة الله وبركاته هدفيه للعاملين بالكنترولات المدرسيه ...... _ سجلات اعمال الكنترول كامله ... _ توزيع الملاحظين اليا على اللجان .... مع تحياتى ....

في موضوع لاخي الكريم // مؤمن جمعة (عمل لوحه UserForm بترحيل بيانات) علي الرابط التالي http://www.officena.net/ib/index.php?showtopic=49583&hl= وطلبه لتصميم برنامج لمتابعة حركة السيارات وتسجيل العمليات المتعلقة ونظرا لان عنوان الموضوع لا يدل علي محتواه وبعد اذن ادارة المنتدي طرحت الموضوع بشكل منفصل حتي يكون في متناول الجميع ولسهولة البحث بعد ذلك بالمنتدي الكريم ويمكن تعديل القاعدة لتتلائم مع شركات تاجير السيارات واضافة حساب كيلومترات السيارة وتكلفة الايجار علي حسب الحاجة وادعوا الله ان يكون الموضوع فيه الفائدة للسائل او الباحث شرح موجز لوظائف الفورم ولا تنسونا بدعوة بظاهر الغيب بصلاح الحال متابعة السيارات.rar

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

السلام عليكم ورحمة الله وبركاته اخواني/اخواتي رأيت الكثير من الاسئلة حول تصدير بيانات الاكسس الى الاكسل ، وكل سؤال يختلف عن غيره بطريقة او اخرى ، فحبيت ان اضع بين يديكم برنامج اشتغلت عليه ، واتمنى من الله سبحانه وتعالى انه يقدر يخدم الكل البرنامج سهل الاستعمال ، فكل المطلوب في الواجهة ، ولا تحتاج الذهاب للكود اولا: الواجهة: 1. تختار من مربع السرد ، جدول او استعلام ، 2. على اساس الاختيار في رقم 1 ، ستظهر لك قائمة باسماء الجداول او الاستعلامات في برنامجك ، 3. اسم ملف الاكسل المراد حفظه به ، ومجلد التخزين ، فتلقائيا يكون في نفس مجلد البرنامج ، 4. هنا تكتب اسم صفحة الاكسل التي تريدها (انظر الصورة في الاسفل) ** تستطيع ان تصدر اي عدد من الصفحات الى اكسس (طبعا التصدير يكون باستعمال البرنامج عدة مرات ، في كل مرة تستخدم اسم صفحة جديدة) ، ** تستطيع ان تصدر بيانات جديدة الى نفس الصفحة في اكسس (طبعا التصدير يكون باستعمال البرنامج عدة مرات ، في كل مرة تستخدم *الادخال من خانة* اسفل الخانات الموجودة في الاكسل) ، 5. تستطيع بدء تصدير البيانات الى اي خانة في اكسل مثل A2 او C5 او اي خانة اخرى ، ** تستطيع ان تصدر بيانات جديدة الى نفس الصفحة في اكسس (طبعا التصدير يكون باستعمال البرنامج عدة مرات ، في كل مرة تستخدم *الادخال من خانة* اسفل الخانات الموجودة في الاكسل) ، 6. تستطيع ان تحفظ ملف الاكسل بالصيغ التاليه: "xls" او "xlsx" او "xlsm" او "xlsb" او "csv" او "txt" ، والصيغتين الاوليتين هما الاهم ، والصيغتين الاخيرتين بهم قيود معينة ، 7. تستطيع ان تختار المجلد الذي تريده ، مع كتابة اسم الملف المناسب لك (انظر الرقم 3 اعلاه) ، 8. تستطيع تصدير البيانات مع اسماء الحقول (في الاكسس) ، وتستطيع تصدير البيانات مع عناوين/مسميات الحقول (في الاكسس) ، نلاحظ اعلاه ، بان الجدول elemnts لا يحتوي على عناوين/مسميات الحقول بالعربي ، بينما الجدول elemnts2 يحتوي عليها ، وتستطيع تصدير البيانات فقط بدون اسماء الحقول ، 9. تستطيع ان تصدر البيانات الى ملف اكسل فيه بيانات سابقة ، وهنا تستطيع الاستفادة من الارقام 4 و 5 اعلاه ، او ان تحذف ملف الاكسل الموجود حاليا بنفس الاسم ، وتبدأ تصدير ملف جديد ، 10. بعد تصدير البيانات الى اكسل ، هل تريد إحتواء وتوسيع كل الاعمدة فيه ، حتى ترى كل البيانات بدون الحاجة الى توسيع كل عمود على حدة ، او لا تريد توسيع الاعمدة. 11. الزر الذي يقوم بعملية تصدير البيانات الى اكسل ، حسب الاختيارات اعلاه ، مع ملاحظة: يجب تعبئة الحقول داخل المربعات الحمراء ، اما بقية الحقول فإختيارية ، 12و 13. لجعل هذا البرنامج يعمل على اي من برامجكم الحاليه ، يجب تصدير النموذج frm_Export_to_Excel و الوحدة النمطية fFolder_Dialog اليها. طبعا هناك أفضلية تصدير البيانات من الاستعلام ، حيث تستطيع ان تتحطم بالبيانات المطلوب تصديرها. ملاحظات؟ اخطاء/عطل؟ إضافات؟ انا في الخدمة ، قدر المستطاع جعفر -------------------------------------------------------- الموضوع منقول من منتدى شقيق وتم نقله كماهو وذلك للاهميه الرجاء الدعاء للاستاذ : جعفر بارك الله فيه Export_to_Excel تصدير البيانات الى اكسيل.zip

بارك الله فيك عمل رائع

تفضل جرب المرفق عندي ملاحظة من فضلك حول شيت ( الأكواد) الذي في الملف يوجد به معلومات مكررة لعدد من الأشهر ما فائدة الأشهر ؟ كود المدرسة سيظل ثابتا مهما تغير الشهر لانه ليس له ارتباط بالشهر تحياتي عمل بطاقة للموظف والمدرسة3.rar

استغفر الله العظيم

بارك الله فيك على العمل الرائع والشرح

شكرا كتييييييييير الك ولجهودك اخ الصقر جزاك الله خيرا

هل من الممكن اضافة استدعاء لفاتورة والتعديل عليها

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

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

أخى الحبيب ياسر فتحى بارك الله فيك ، سلمت من كل شر ، يشرفنى مرورك وتشجيعك الدائم يا بش مهندس

نسأل الله ان يسكنه فسيح جناته وان يجازيه بالاحسان احسان وان كان محسنا فيزيد فى احسانه وان كان مسيئا فيتجاوز عن سيئاته وهذه من احدى اعمالع الرائعه http://www.officena.net/ib/topic/63597-مش-مهم-تكون-محترف-vba-ولكن-مهم-يكون-عندك-معلومات-عن-vba/?do=findComment&comment=414555 تقبلوا تحياتى

قم بسحب المعادلات إلى الأسفل لإظهار بقية الطلاب تفضل جرب المرفق رصد درجات الطلاب2.rar

جرب الدالة التالية Function YK(sInp As String) As Long Static bInit As Boolean Dim asMap() As String Dim asLtr() As String Dim I As Long Static aiVal(0 To 255) As Long If Not bInit Then asMap = Split("1 1 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 26 27 28") asLtr = Split("أ ا إ ب ت ث ج ح خ د ذ ر ز س ش ص ض ط ظ ع غ ف ق ك ل م ن ه ة و ي") For I = 0 To UBound(asMap) aiVal(Asc(asLtr(I))) = asMap(I) Next I bInit = True End If For I = 1 To Len(sInp) YK = YK + aiVal(Asc(Mid(sInp, I, 1))) Next I End Function Sum Letters YasserKhalil V3.rar

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

حبيبى الغالى أ / ياسر خليل أنا مقدرش أزعل منك أبدا بس أنا رديت بسرعة على الموضوع تقبل خالص تحياتى وتقديرى مرفق الملف مع فتح محرر الأكواد ويوجد مثال لأسماء مكررة للتجربه فصل المكرر.zip

اللهم ارحم امواتنا واموات المسلمين جميعا

البقاء لله

إن لله ما أخذ وله ما أعطى وكل شىء عنده بأجل مسمى

انا لله و انا اليه لراجعون لاحول ولا قوة الا بالله العلي العظيم اللهم اغفر له و ارحمه واعفو عنه و اكرم نزله ووسع مدخله وأسكنه دار خيراً من داره واهلاً خيراً من أهله

اللهم ابدله دارا خيرا من داره واهلا خيرا من اهله وادخله الجنة واعذه من عذاب القبر ومن عذاب النار . اللـهـم عاملة بما انت اهله ولا تعامله بما هو اهله . اللـهـم اجزه عن الاحسان إحسانا وعن الأساءة عفواً وغفراناً. اللـهـم إن كان محسناً فزد من حسناته , وإن كان مسيئاً فتجاوز عن سيئاته . اللـهـم ادخله الجنة من غير مناقشة حساب ولا سابقة عذاب . اللـهـم اّنسه في وحدته وفي وحشته وفي غربته. اللـهـم انزله منزلاً مباركا وانت خير المنزلين . اللـهـم انزله منازل الصديقين والشهداء والصالحين وحسن اولئك رفيقا . اللـهـم اجعل قبره روضة من رياض الجنة ,ولا تجعله حفرة من حفر النار . اللـهـم افسح له في قبره مد بصره وافرش قبره من فراش الجنة . اللـهـم اعذه من عذاب القبر ,وجاف ِالارض عن جنبيها . اللـهـم املأ قبره بالرضا والنور والفسحة والسرور. اللـهـم إنه فى ذمتك وحبل جوارك فقه فتنة الفبر وعذاب النار , وانت أهل الوفاء والحق فاغفر له وارحمه انك انت الغفور الرحيم. اللـهـم انه عبدك وابن عبدك خرج من الدنيا وسعته ومحبوبيه وأحبائه إلي ظلمة القبر وماهو لاقته . اللـهـم انه كان يشهد أنك لا إله الا انت وأن محمداً عبدك ورسولك وانت اعلم به. اللهم ثبته عند السؤال اللهم انا نتوسل بك اليك ونقسم بك عليك ان ترحمه ولا تعذبه اللـهـم انه نَزَل بك وأنت خير منزول به واصبح فقير الي رحمتك وأنت غني عن عذابه . اللـهـم اّته برحمتك ورضاك وقه فتنه القبر وعذابه و أّته برحمتك الامن من عذابك حتي تبعثه إلي جنتك يا أرحم الراحمين . اللـهـم انقله من مواطن الدود وضيق اللحود إلي جنات الخلود . اللـهـم إحمه تحت الارض واستره يوم العرض ولا تخزه يوم يبعثون "يوم لا ينفع مال ولا بنون إالا من أتي الله بقلب سليم" اللـهـم يمن كتابه ويسر حسابه وثقل بالحسنات ميزانه وثبت علي الصراط اقدامه واسكنه في اعلي الجنات بجوار حبيبك ومصطفاك (صلي الله عليه وسلم) .

رحمه الله واسكنه فسيح جنانه وإنا لله وإنا إليه لراجعون

انالله وانا اليه راجعون. نسال الله سبحانه ان يتغمده بواسع رحمته

انالله وانا اليه راجعون. نسال الله العظيم رب العرش الكريم ان يتغمده بواسع رحمته ويسكنه فسيح جناته

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

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

بسم الله الرحمن الرحيم اخواني الكرام اسعد الله ايامكم وبعد هذا ملف رائع مبذول فيه جهد ملحوظ ندعو الله ان يجازي كل من ساهم في اخراجه الى النور وهو الاستاذ عادل حنفي واستاذ يوسف ****** ارجو من حضراتكم *** اضافة كود ليفتح الملف وتكون لغة الكتابه دائما باللغه العربيه ثانيا : اضافة جزئيه في كود التوزيع العشوائي انه عند الضغط على زر DO JOB ونكون قد كتبنا يدويا حرفالحاء لبعض الاسماء يتم التوزيع كاملا مع ترك هذه الاحرف ليكونوا احتياطيا وجزاكم الله كل خير توزيع الملاحظين.rar 342.93K 80 عدد مرات التحميل

تم التعديل كما اردت ، وعليك تغيير المدى حسب احتياجك File N Foler2.rar

السلام عليكم فورم بحث مرن وسريع بامكانك استخدامة بدلا من القائمة المنسدلة وخاصة مع البيانات الكثيرة ويقوم بوضع نتيجة البحث في الخلية النشطة امكانياته 1 - ممكن استخدامه للبحث في اكثر من نطاق في الورقة او في الملف ما عليك سوى تضيف كود لفتح الفورم وتغيير نطاق البحث فيه مثلا Sub KH_SHOW() With UserForm1 .kh_SetRng Sheets("t1").[B3:B200] .Show End With End Sub 2 - يقوم بوضع نتيجة البحث في الخلية النشطة في اي مكان في الملف 3 - يمكنك تحديد خلية وضع نتيجة البحث والفورم مفتوح 4 -بامكانك استخدامة للبحث في اكثر من عمود المرفق 2003 بحث.rar

السلام عليكم ورحمة الله وبركاتة اضافة صورة الى تعليق الخلية لنشاهد المرفق ___________________________.rar

السلام عليكم دالة الصفيف kh_MatchArray لارجاع ارقام صفوف سجلات حسب شروط الوسائط: عبارة عن صفيف يحقق (شرط / شروط) في عمود معين من قاعدة البيانات ادخل الشروط التي تريدها من 1 الى 30 الاستخدام : كشوفات الحساب التقارير بانواعها الميزة : لا ترهق الجهاز في المثال المرفق استخدمتها لقاعدة بيانات عدد سجلاتها اكثر من 15000 سجل والسبب انها معادلة وحدة نتائجها صفيف لهذا توضع على اكثر من خلية ولكن مكان تعديلها الخلية الاولى لوضعها مع تحديد باقي الصفوف الموضوعة فيها . اضغط F2 لتحرير الصيغة ثم اضغط CTRL+SHIFT+ENTER اذا حاولت تعدل اي خلية موضوعه فيها الدالة (جزء من صفيف الدالة) تظهر لك رسالة ( لا يمكنك تعديل جزء من صفيف) استخدم حينها ESC لانهاء تحرير الدالة . طبعا نتائجها ارقام الصفوف التي تحقق الشرط اعلى نطاق الدالة والاخرى رقم صفر بمعنى لا يحقق الشرط وهي اسفل النطاق تضعها في عمود يمين او يسار الكشف المتبقي علينا نستخدم دالة INDEX لاظهار الاعمدة الت نريدها من قاعدة البيانات كود الدالة: Option Explicit '============================================= '============================================= Function kh_MatchArray(ParamArray Array1() As Variant) Dim Ar() As Long Dim x As Integer, xx As Integer, xxx As Integer Dim iCont As Long, i As Long, ii As Long xx = UBound(Array1) If xx = -1 Then GoTo kh_Err iCont = UBound(Array1(0), 1) ReDim Ar(1 To iCont, 1 To 1) For i = 1 To iCont xxx = 1 For x = 0 To xx xxx = xxx * IIf(CBool(Array1(x)(i, 1)), 1, 0) Next If xxx Then ii = ii + 1: Ar(ii, 1) = i Next kh_MatchArray = Ar kh_Err: Erase Ar End Function المرفق 2003-2007 kh_MatchArray.rar

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

السلام عليكم و هذا اهداء اليك اخي الحسامي حتي اشعر باشتراكي معكم في اثراء هذا الموضزع خالص تحياتي و تقديري البرنامج15.rar

السلام عليكم اخي العزيز والحبيب الخالدي كل يوم تثبت لنا انك عالم كبير في مجال المعادلات الصعبة فبارك الله فيك وجزاك الله خيرا وهنا لاثراء الموضوع حل اخر باستخدام الاكواد البرنامج11.rar

السلام عليكم ورحمة الله وبركاته حسب ما فهمت من طلبك شاهد المرفق البرنامج11.rar

مثال على نموذج يحوي نماذج فرعية بثلاثة مستويات SubForm3Levels2k.rar