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

السلام عليكم ورحمة الله تعالى وبركاته اولا لم اجد استخدام الرموز الدولية الموحدة Unicode لا فى منتديات عربية ولا اجنبية ولا ادرى ان سبقنى اليها احد من قبل فى ستخدامها داخل الاكسس ولكنه توفيق من الله بالنسبة لى وسوف اشرح طريقة التوصل الى التعامل الصريح بـعلامة ( √ ) أو علامة ( x ) فى قواعد البيانات -------------- -------------- -------------- -------------- -------------- -------------- -------------- -------------- -------------- واخيـــــــــــــ( المرفق )ـــــــــــــــرا ( √ ) أو ( x )علامة.mdb

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

كل صفحة من اكسل 2010 تحتوي على: 1,048,576 صف (اكثر من مليون صف ) 16,384 عامود (اكثر من 16000 عامود) اي 1048576 × 16384=17,179,869,184 خلية (اكثر من 17 مليار خلية ) اكثر بثلاث مرات عدد سكان الارض هل تستطيع أن تملأها بيانات للتأكيد هذا الماكرو Option Explicit Sub Cells_numbe() Dim x, y, z x = ActiveSheet.Rows.Count y = ActiveSheet.Columns.Count z = x * y Cells(1, 1) = "Rows Count" Cells(1, 2) = "Columns Count" Cells(1, 3) = "Cells Count" Cells(2, 1) = x Cells(2, 2) = y Cells(2, 3) = z End Sub

السلام عليكم ورحمة الله تعالى وبركاته من منا يمل من كثرة استخدام الرسائل مثلى ويظل يفكر فى كل مرة كيف سيكتب الكود المناسب الان موديول واحد به الحل النهائى المرن فى التعامل مع الرسائل وحتى لا ننسي الفضل لاصحاب هذا العمل الحقيقين الاستاذ @أبو هادي >>----> تعريب الصندوق الاستاذ @ابوخليل >>----> تعريب الصندوق الاستاذ @أبو آدم >>----> تلوين محتوى الرسالة هذا المثال الذى اهديه لكم هو خلاصة دمج الاكواد المستخدمة من كل معلم من هؤلاء العظماء مع بعض التطوير البسيط الذى لا يذكـر اصلا والذى فقط يضفى المرونة فى سهولة استدعاء الكود داخل اى نموذج مع مرونة التغيير فى اضافات الرسالة او عنوان الرسالة حسب متطلبات المبرمج - ملاحظة للمرة الاولى احاول التوفيق بين الأكواد التى تعمل على كل من النواتين 64 بيت والـ 32 بيت ولا اعلم صراحة هل وفقت فى ذلك ام لا شرح سريع لمحتوى المثال المرفق اولا أكواد الموديول هذا الكود للاستاذ الجليل الاستاذ @أبو آدم '---- اللألوان -------------------------------------------------------------------------------- #If Win64 Then Declare PtrSafe Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long Declare PtrSafe Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long #Else Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long Declare Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long #End If Public DefaultColour As Long Public Const COLOR_WINDOWTEXT As Long = 8 Public Const CHANGE_INDEX As Long = 1 طريقة استخدام الكود بالاستدعاء داخل اى مكان بالبرنامج DefaultColour = GetSysColor(COLOR_WINDOWTEXT) ' تخزين لون ثيم النظام الافتراضي SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, vbRed ' اضبط لون ثيم النظام على اللون الأحمر MsgBox "you welcome in officena forums", , "welcome" ' كود الرسالة SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, defaultColour ' استعادة القيمة الافتراضية بعد اغلاق الرسالة الشرح تفصيلا لكل سطر بالكود DefaultColour = GetSysColor(COLOR_WINDOWTEXT) هذا السطر لحفظ تنسيق الالوان المستخدم فى ثيم الويندوز ثم SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, vbRed هذا يغير اعدادت ثيم الويندوز لتغير لون الكتابة الى اللون الاحمر طبعا يمكن تغيير اللون كيفما تريد بتغير vbRed الى ما تريده انت ثم نكتب الرسالة داخل الكود المخصص لها مثلا MsgBox "you welcome in officena forums", , "welcome" ثم بعد عرض الرسالة العودة مرة اخرى للون المفضل لثيم الويندوز والذى اختفظنا به فى الجزء الاول من الكود SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, DefaultColour وبهذا انتهى جزء تلوين محتوى النص للرسالة الجزء الثانى من الكود داخل الموديول والخاص بتعريب الأزرار الاستاذ @ابوخليل / الاستاذ @أبو هادي #If Win64 Then Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long #Else Declare Function GetCurrentThreadId Lib "kernel32" () As Long Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long #End If Private m_hHook As Long Const IDOK = 1 Const IDCANCEL = 2 Const IDABORT = 3 Const IDRETRY = 4 Const IDIGNORE = 5 Const IDYES = 6 Const IDNO = 7 Const IDCLOSE = 8 Const IDHELP = 9 Const WH_CBT = 5 Const GWL_HINSTANCE = (-6) Const HCBT_ACTIVATE = 5 Public Sub MessageBoxFullArabicButtons(hwndThreadOwner As Long) Dim hInstance As Long Dim hThreadId As Long hInstance = GetWindowLong(hwndThreadOwner, GWL_HINSTANCE) hThreadId = GetCurrentThreadId() m_hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, hInstance, hThreadId) End Sub Private Function MsgBoxHookProc(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If uMsg = HCBT_ACTIVATE Then SetDlgItemText wParam, IDOK, "موافق" SetDlgItemText wParam, IDCANCEL, "إلغاء" SetDlgItemText wParam, IDABORT, "إحباط" SetDlgItemText wParam, IDRETRY, "إعادة" SetDlgItemText wParam, IDIGNORE, "تجاهل" SetDlgItemText wParam, IDYES, "نعم" SetDlgItemText wParam, IDNO, "لا" SetDlgItemText wParam, IDCLOSE, "إغلاق" SetDlgItemText wParam, IDHELP, "مساعدة" UnhookWindowsHookEx m_hHook End If MsgBoxHookProc = False End Function الجزء التالى هو بناء كود عام للرسالة حتى يسهل استخدامه باستدعائه بكل سهولة فى جميع نماذج البرنامج Public Function MyMesg(Mesgtxt As String, _ Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _ Optional ByVal Title As String = "تطوير صندوق الرسائل العربى من منتديات اوفيسنا", _ Optional ByVal HelpFile As Variant, _ Optional ByVal Context As Variant) As VbMsgBoxResult MessageBoxFullArabicButtons Application.hWndAccessApp MyMesg = MsgBox(Mesgtxt, Buttons + vbMsgBoxRtlReading + vbMsgBoxRight + vbDefaultButton1, Title) End Function نلاحظ الاتى بوجه عام هذا الكود تم تصميمه على ان يكوم اقتراضيا بهذا الشكل الرسالة بسيطة تحتوى على زر امر واحد Buttons As VbMsgBoxStyle = vbOKOnly عنوان الرسالة الإفتراضى Title As String = "تطوير صندوق الرسائل العربى من منتديات اوفيسنا" الجزء من الكود هذا MessageBoxFullArabicButtons Application.hWndAccessApp الذى يستدعى تعريب الازرار السطر الاخير البناء الطيعى لتكوين كود الرسالة بالاضافات التى يفضلها المبرمج MyMesg = MsgBox(Mesgtxt, Buttons + vbMsgBoxRtlReading + vbMsgBoxRight + vbDefaultButton1, Title) طريقة استخدام الكود بالاستدعاء داخل اى مكان بالبرنامج MyMesg "منتديات أوفيسنا ترحب بكم" لتغيير العنوان الافتراضى MyMesg "منتديات أوفيسنا ترحب بكم",,"العنوان الجديد كما تريد" استخدام الاضافات لتغيير الازرار مثلا MyMesg "هل أعجبتك هذه الترجمة و التعديلات والأفكار؟", vbYesNo مع عنوان مخصص MyMesg "هل أعجبتك هذه الترجمة و التعديلات والأفكار؟", vbYesNo,"عنوان جديد" والان وصلنا الى نهاية الموضوع اسأل الله تعالى ان يرزق اساذتنا العظماء الذين كان لهم الفضل فى هذا الموضوع البركة فى العمر والعلم والرزق والاهل والولد اللهم اغفر لهم ولوالديهم واللهم احسن اليهم كما احسنوا هم الينا اللهم تقبل اعمالهم يارب العالمين فى موازين اعمالهم وضاعف حسناتهم و الاجر اضعافا مضاعفة يارب العالمين اللهم ارفع درجاتهم فى أعلى درجات الجنان ودرجاتهم والديهم يارب العالمين امين امين امين Full Arabic Message Box.accdb Full Arabic Message Box.mdb

يسأل الكثير والكثير عن مدى قدرة تطبيق قاعدة البيانات Microsoft Access Database لتحمل البيانات وكم من الأحاديث والشائعات التي تدور حول الإجابة الواضحة لهذا السؤال. دعونا نتحدث بشيء من التفصيل عن Microsoft Access ونأخذ جولة عن Microsoft ACCESS Database Application MS ACCESS بالتحديد هو عبارة عن صورة مصغرة لتطبيقات ونظم إدارة قواعد البيانات العلائقية أو RDBMS ولكن ما يميز MS ACCESS يزود مستخدميه بنوع من السهولة واليسر أثناء الإستخدام فضلاً عن نظائره المشار إليها سابقاً مثل Microsoft SQL Server أو My SQL Server أو ORACLE أو Sybase ...الخ. ودعوني بلجهتي المصرية أقول عن الأكسيس مقارنة بما سبق ذكره أنه عبارة عن( سندوتش قاعدة بيانات ) ... يعني شيء كدة في السريع !! ولكن هذا لا يمنع وجود قوة كامنة في MS ACCESS والتي سنبرزها بعد قليل ... ولكن هنا دعونا نتجه إلى شيء غاية في الأهمية: س: ما الدافع الذي يدفعك إلى استخدام MS ACCESS ؟؟؟؟ ج: بكل بساطة لأنه كنتيجة للتحليل البيئي للعميل وتحليل النظم الخاص بعمله أو منشأته قد يتبين لنا عدم وجوب استخدام قاعدة بيانات ضخمة مثل SQL Server أو ORACLE .... الخ ، ولذلك - طبقاً للفحص والتحليل - إن قاعدة بيانات MS ACCESS ملائمةجداً. س: بصفتك مبرمج ماذا تعرف عن MS ACCESS من حيث المميزات والعيوب؟؟؟ ج: قواعد البيانات ACCESS من عيوبها بطئ في نقل البيانات على الشبكة سعتها صغيرة ولا تتحمل الكثير من البيانات ولكن لا أعرف بالتحديد كم تسع وليس لدي أيضاً علم بالحد الأقصى من الكائنات التي تتحملها طبعا باضحك عليكم انا عارف والاجابة تفصيلا مواصفات قاعدة البيانات -----لمحة عامة عن قاعدة البيانات: قاعدة بيانات Microsoft ACCESS ذات اللاحقة أو الاسم الممتد ( mdb أو accdb ) هي عبارة عن تجميعة أو مجموعة من البيانات والكائنات الخاصة بإحتواء وإدخال وإخراج البيانات وإجراء العمليات المختلفة عليها. سعتها التخزينية لا تتعدى الـ ( 2 جيجا بايت ، 2 GB) ، والمساحة السالف ذكرها تتضمن البيانات بالاضافة إلى المساحة التخزينية التي تشغلها كائنات قاعدة البيانات مثل الجداول والإستعلامات والوحدات النمطية والإجراءات المخزنة. لا تتحمل قاعدة البيانات أن تحوي بداخلها الكائنات السابق ذكرها في النقطة السابقة بأكثر من 32,768 كائن. تقول Microsoft بأن تطبيق MS ACCESS يستطيع أن يتحمل تلاقي وتزامن 255 مستخدم في نفس الوقت ، ولكنها تقول أن هذا العدد سيقل بكثيرأثناء الـ Design-Time -----لمحة عامة حول الجداول: عدد الجداول التي تستطيع قاعدة البيانات تحملها هو نفس عددالكائنات بصفة عامة التي تستطيع قاعدة البيانات تحملها وهذا على أساس أن القاعدة لا تحوي داخلها إلا الجداول فقط وهو العدد السابق ( 32,768 ). وكما فعلنا مع الحد الأقصى للكائنات ، سنقوم بذلك مرة أخرى مع المساحة ، وهنا أقصد أن الجدول الواحد يستطيع احتواء 2 جيجا بايت تتضمن البيانات والحجم اللازم لمحتويات قاعدة البيانات وهذا باعتبار أن قاعدةالبيانات لا تحتوي إلا على هذا الجدول. لا يمكنك تسمية الجدول بسلسلة نصية طولها أكثر من 64 حرف. وكذلك بالنسبة للحقول تنطبق عليها ما انطبق على اسم الجدول. عدد الجداول المفتوحة حسب ما تلقينا من Microsoft هو 2048 ، ويُقصد بها عدد الجداول المفتوحة في نفس ذات اللحظة ، ولكن في الواقع يقل هذا الرقم كثيراً وهذا لأن تطبيق MS ACCESS يقوم بقتح الجداول داخلياً دون أن تظهر بشكل فيزيائي مادي أمامك. نرجع ثانية للمساحة أو السعة التخزينية القصوى وهي الـ ( 2 جيجا بايت ) ، وللتنويه لو أنت من مستخدمي MS ACCESS 2000 or 97 فلن تحظى إلا بـ ( 1 جيجا بايت فقط ) ، ولو حالفك الحظ وكنت تستخدم الإصدارات الأرقى منذلك فستكون من حلفاء الـ ( 2 جيجا بايت ). إليك هذه المعلومة: نعرف جميعا حقول المذكرات من النوع( مذكرة / Memo ) هل خطر ببالك كم تسع تلك الحقول ؟؟ ........ تسع تلك الحقول مقدار من الحروف بعدد ( 65,535 ) هذا إن كنت قد أدخلت البيانات من خلال واجهة التطبيق MS ACCESS User Interface ولكن إن قمت بالإدخال برمجياً فلك أن تتخيل أن هذا الحقل قد تحول إلى بئر عميق يسع من البيانات ما يساوي الـ ( 1 جيجا بايت ) ولكن لا تسألني عن السبب لأنها عملية فيزيائية تتعلق بمحرك MS ACCESS شخصياً ودعونا لا نتدخل في شئون الآخرين هههههه . بالنسبة للحقول من النوع ( OLE ) تسع ما يساوي الـ ( 1 جيجا بايت ) من البيانات. الجدول الواحد لا يستطيع أن يحوي بداخله أكثر من 32 فهرس / Index. عدد الحروف التي تستطيع أن تحويها الحقول باستثناء الـ ( Memo ،OLE ) حين تكون خاصية الـ ( Unicode Compression ) قيمتها تساوي Yes هي كالتالي: بالنسة للإصدار 2000-203 = 4000 حرف أما بالنسبة للإصدار XP فانها = 2000 حرف. -----لمحة عامة حول الإستعلامات: الحد الأقصى للعلاقات داخل الإستعلام الواحد هو ( 32 ) علاقة بما فيها من فهارس وهذا يعني أن لو الفهارس المدرجة بالجداول الواردة بالاستعلام = 5 فهارس ، فلن يحتوي هذا الإستعلام أكثر من 27 علاقة Enforced Relationship. عدد الجداول المدرجة بالإستعلام لا يزيد عن 32 جدول لكل استعلام. السجل الواحد لا يستطيع أن يحتوي على أكثر من 255 حقل. كل سجل داخل الاستعلام لايزيد عن ( 1 جيجا بايت ). عدد مستويات الإستعلامات المتدرجة Nested Queries لا تتعدى الـ 50 مستوى. جملة الاستعلام الخاصة بالإستعلام تستطيع حمل حوالي ( 64.000 حرف ) بداخلها. -----لمحات خاطفة عن التقارير والنماذج: مربع العنوان ( Label ) يستطيع حمل 2048 حرف. مربع النص ( TextBox ) يستطيع حمل 65,535 حرف. أقصى عرض للتقرير أو للنموذج = 22 إنش ، أو ، 55.87 سم. طول القسم الواحد = 22 إنش ، أو ، 55.87 سم. مجموع أطوال الأقسام Sections في وقت التصميم إضافة لرأس الكائن ( النموذج أو التقرير ) = 200 إنش ، أو ، 508 سم. عدد مستويات التقارير والنماذج المتدرجة كما يلي: في الإصدار 2003 و XP يصل إلى 7 مستويات ، أما الإصدار 2000 فما هم إلا 3 مستويات. يمكنك استخدام ( 10 ) حقول لعمل فرز وتجميع كحد أقصى ... Sorting and Grouping. يمكنك فقط استخدام عدد ( 1 ) Report/Page Header/Footer ، ولكن يمكنك استخدام ( 10 ) Group Header/Footer. التقرير الواحد لا يمكن أن يتضمن أكثر من ( 65,536 ) صفحة للطباعة. لا يمكنك إضافة أو رسم أدوات أكثر من 754 أداة على النموذج أو التقرير ، والأدوات معروفة للجميع مثل مربع العنوان وزر الأمر وما إلى ذلك ، ويتضمن الرقم السابق ذكره عدد الأقسام الموجودة بالنموذج أو التقرير. -----لمحات خاطفة عن الماكرو: عدد الإجراءات في الماكرو 999 عدد الأحرف في الشرط 255 عدد الأحرف في التعليق 255 عدد الأحرف في وسيطة الإجراء 255 تم بحمد الله

Expand And Collapse( الطى والتوسيع ) ExpandCollapse( الطى والتوسيع).mdb

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

السلام عليكم 🙂 اللغة العربية هي المطلوبة هنا 🙂 المرفق المضغوط فيه مجلد وبرنامج اكسس ، والبرنامج اللي يعمل لنا QR code ، ويتم حفظ الصورة هنا Data > QR_images وعلشان كل شيء يشتغل تمام ، رجاء لا تعمل تغيير في مكان الملفات ولا المجلدات ، ولا تغيير اسمائها (طبعا تقدر تعمل اللي تريد ، بس على اساسه يجب تغيير الكود كذلك) وهي النتيجة: وخلونا نشوف من يقدر يقرأ الصورة 🙂 ----------------------------------------------------------------------------- إضافة في يوم الثلاثاء 7 / 5 / 2019 : عملت مثال يعمل على 2003 🙂 ----------------------------------------------------------------------------- إضافة في يوم الجمعة 14 / 6 / 2019 : اختار الحقول اللي تريدها تظهر في QR code بإختيار مربع صح/خطأ : . والنتيجة: . و باركود 128 (ويمكن عمل اي نوع من انواع الباركود) . والتقرير (وبعد اذن اخي محمد سلامه ، فقد استعملت الصورة التي استعملها في مثاله 🙂 ) . وبهذه الطريقة نرى اننا لا نحتاج ان نحفظ صورة لكل سجل (واذا اردنا ذلك ، فنعمل تعديل في الكود ليقوم بذلك). وهذا الكود مضافا اليه عمل الباركود العادي : Private Sub Make_QR_Barcode() ' 'https://sourceforge.net/projects/zint/ ' If Len(Me.str_Text & "") = 0 Then Exit Sub Dim App_Name As String Dim Output_File As String Dim Output_Text As String Dim Encoding As String App_Name = Chr(34) & Application.CurrentProject.Path & "\Data\zint.exe" & Chr(34) Output_Text = Chr(34) & Me.str_Text & Chr(34) 'QR code Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & "QR_code.png" & Chr(34) ShellWait App_Name & " -o " & Output_File & " --rotate=0 --eci=24 --scale=2 -w 10 --height=100 --barcode=58 -d " & Output_Text 'Barcode 128 Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & "Barcode.png" & Chr(34) ShellWait App_Name & " -o " & Output_File & " --rotate=0 -d " & Me.ID 'PDF 417 Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & "PDF_417.png" & Chr(34) ShellWait App_Name & " -o " & Output_File & " --rotate=0 --eci=24 --binary --barcode=55 --mode=3 -d " & Output_Text End Sub المرفق في ملفين بصيغة txt والذي فيهما جميع الاوامر التي يمكن استعمالها لعمل مختلف انواع الباركود 🙂 جعفر zint QR.zip

أهلا @qathi أرجو أن يكون المثال سهل الفهم D3.accdb

🎈عيد سعيد🎈 هديــــة العيد : تحويل التاريخ يحتوى المرفق على بعض الاكواد المجمعة فى موديولات لا غنى عنها تحويل التاريخ.zip

بناء على اقتارح الاخ أبو جودي هنا : اضافة خيار - تم الاجابة يرجي التصويت ، بعد قراءة الموضوع التصويت لاستطلاع رأي الاعضاء ، و سيتم مناقشة المزايا و العيوب مع فريق الموقع على التوازي

تفضل .... Dim dbs As Database, tdf As TableDef Set dbs = CurrentDb For Each tdf In dbs.TableDefs If Left(tdf.Name, 4) <> "msys" _ And tdf.Attributes = 1 Then tdf.Attributes = tdf.Attributes - dbHiddenObject End If If tdf.Attributes = 1073741825 Then tdf.Attributes = 0 Next tdf Set dbs = Nothing Call ViewTablePage

هل جربت هذا الكود .... Private Sub ViewTablePage() DoCmd.SelectObject acTable, , True SendKeys "{F5}" End Sub Private Sub VisibleTable_Click() Dim db As Database Dim tdf As TableDef Set db = CurrentDb For Each tdf In db.TableDefs If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 Then tdf.Attributes = tdf.Attributes + dbHiddenObject End If If tdf.Attributes = 1073741824 Then tdf.Attributes = 1 Next db.Close Set tdf = Nothing Set db = Nothing Call ViewTablePage End Sub

زيادة في اثراء الموضوع هذا الكود Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$A$2" And _ Target.Count = 1 Then My_validation End If Application.EnableEvents = True End Sub Rem================================ Sub My_validation() Dim Bayanat As Worksheet: Set Bayanat = Sheets("البيانات") Dim Amaliate As Worksheet: Set Amaliate = Sheets("العمليات") Dim arr(), Ro%, t%, Col%, st$ Ro = Bayanat.Range("a:a").Find(Amaliate.Cells(2, 1)).Row Col = Bayanat.Cells(Ro, Columns.Count).End(1).Column For t = 2 To Col ReDim Preserve arr(1 To t - 1) arr(t - 1) = Bayanat.Cells(Ro, t) Next st = Join(arr, ",") With Amaliate.Cells(2, 2).Validation .Delete .Add xlValidateList, Formula1:=st End With Amaliate.Cells(2, 2) = arr(1) Erase arr End Sub المبف مرفق variable_data_val.xlsm

وعليكم السلام -بعد اذن الأستاذ مصطفى ولإثراء الموضوع 1ملف العملاء.xlsx

يمكن تعبئة الخلايا الفارغة بدون (Sort) ابجدياً بواسطة هذا الماكرو Option Explicit Sub give_Data() With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim last_ro# last_ro = Range("a1").CurrentRegion.Rows.Count Range("MM2").Resize(last_ro - 1).Formula = _ "=IF(AND(C2<>"""",D2<>""""),D2,INDEX($D$2:$D$" & last_ro & ",MATCH(C2,$C$2:$C$" & last_ro & ",0))" & ")" Range("D2").Resize(last_ro - 1).Value = _ Range("MM2").Resize(last_ro - 1).Value Range("MM2").Resize(last_ro - 1) = vbNullString With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub الملف مرفق FiLL_Empty.xlsm

السلام عليكم ورحمة الله استخدم هذه الدالة المعرفة Function Repeat_Int(Rng As Range) For i = 1 To Len(Rng) If IsNumeric(Rng) Then If Mid(Rng, i, 1) = 1 Then p = p + 1 End If End If Next Repeat_Int = p End Function

الشيت ثقيل لانك تجعل الكود ينتظر ثانية واحدة في كل خطوة من خلال الدالة Wait ما مجموعه (55 × 57 =4125 ثانية اي حوالي ساعة وربع) جرب هذا الماكرو Sub salama() Application.ScreenUpdating = False Dim My_num, i#, col# Dim color_index% color_index = 1 + 18 * Rnd() For i = 3 To 55 For col = 2 To 57 Select Case Cells(i, col) Case 1: My_num = 2 Case 2: My_num = 3 Case 3: My_num = 1 Case Else: My_num = "" End Select Cells(i, col) = My_num Cells(i, col).Interior.colorindex = color_index Next Next Application.ScreenUpdating = True End Sub '=================================== 'هذا الكود للتصحيح في حال ادخال رقم مختلف بالخطأ Sub reset() Application.ScreenUpdating = False Dim i#, col# For i = 3 To 55 For col = 2 To 57 If Cells(i, col) <> vbNullString Then _ Cells(i, col) = 1 Next Next Application.ScreenUpdating = True End Sub 2030.xlsm

تفضل رصد الدرجات1.xlsm

وهذا مثال على الفزر بالاستعلامات اعتذر كان تقصير منى عدم انشاء الاستعلامات فى المثال السابق ( √ ) أو ( x ) - الفرز -علامة.mdb

السلام عليكم ورحمة الله تعالى وبركاته اولا: عملية ربط قاعدة بيانات بمسار محدد توضع حيث يتم وضع قاعدة البيانات التي تحتوي غلي الجداول في نفس مجلد قاعدة الواجهة Autolink Path.rar ---------------------------------------- ثانيا :عملية الربط التلقائي بدون تحديد المسار حيث يتم البحث عن قاعدة البيانات المطلوبة لربط الجداول اينما كانت Autolink Table.rar ---------------------------------------- ثالثا :عملية ربط قاعدة الواجهة باكثر من قاعدة link MultiDB.rar مع اطيب وارق الامنيات بالاستمتاع

حياك الله 🙂 ولكن ، همممم ، هل الموضوع مخالف 🙂 لا مانع من إبداء: الشكر والتقدير والاحترام  لكل فريق الموقع ، والخبراء ، والاعضاء والاهم من الشكر ، هو رد الجميل بمساعدة بقية الاعضاء في اسئلتهم🙂 جعفر

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

جرب هذا الكود Option Explicit Sub Tarhil() Dim My_St: My_St = Sheets("data").Range("b1") Dim My_col% My_col = Sheets("tab").Range("A1:F1").Find(My_St).Column Sheets("data").Range("b2", Range("b1").End(4)).Copy _ Sheets("tab").Cells(2, My_col) End Sub

كيفية عمل فورم من خلال الفرام وتخطيط جدول وادراج ماديول جذء 2 الفيديو الصور الملف شرح كيفية عمل فورم من خلال الفرام وطريقة عمل جدول الجذء الثانى.rar

جرب هذا الكود Sub give_data() Application.ScreenUpdating = False Dim x As Byte x = Application.CountA(Sheets("SAISIE").Range("B1:B6")) If x < 6 Then MsgBox "Incomplete Data" & Chr(10) & _ "You have Only " & x & " Values": GoTo Exit_sub Sheets("SAISIE").Range("B1:B6").Copy Sheets("DATA").Range("A" & Rows.Count).End(3).Offset(1) _ .PasteSpecial Paste:=xlPasteAll, Transpose:=True Sheets("SAISIE").Range("B1:B6").ClearContents Exit_sub: Application.ScreenUpdating = True End Sub الملف مرفق COPY-VBA.xlsm

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

السلام عليكم ورحمة الله جرب المرفق لعل فيه ما تريد (مع بعض الزيادة).... بن علية حاجي معادلة الترقيم والتسلسل بدون تكرار.xlsx

السلام عليكم ارجو تجربة المرفق وقد تم مراعاة معظم المشاكل لكن عليكي بان يكون القسم المدرج تحته البيانات مطابقا للعمل للتوضيح يجب ان يكون العمل مادة القرآن الكريم وليس القران تحت قسم مادة القرآن الكريم وقد تم عمل الملف بطريقة يسهل تعاملك معه بالرغم من انه استغرق 3 ايام لفكرة صغيرة وهي كيفية التعرف علي الاقسام والصف الاخير في كل قسم اخيرا بنفس طريقة عملك لهذا الملف صممي الملف الذي سيتم عليه عملك الفعلي والصقي نسحة فارغة من البيانات وليس من الاقسام في شيت Source فهو الشيت الذي يعتمد عليه لعمل نسخة لكل مدرسة ارجو انني قد فهمت المطلوب ونفذ بالطريقة الصحيحة ولو فيه اي استفسار انا منتظر للرد عليه تحياتي حافظة الدوام أوفيسنا.rar

فتح ملف او برنامج محمول بمسار قاعدة البيانات يتم كتابة اسم الف او البرنامج كاملا بالامتداد الخاص به فى الجدول الموجود فى المرفق مع وصف له ان اردت وعند التأشير على الفتح فى الجدول يتم الفتح والاستعراض مرة واحدة بعد التأكد من وجود الملف اولا فى المسار الخاص بقاعدة البيانات open programs.zip

وعليكم السلام تفضل ملف العملاء.xlsx

حماية الأكواد .... والنماذج و التقارير من العبث أو معرفة الاكواد الموجوده بها

السلام عليكم يسعدنا انضمام الأخ على محمد على الي فريق الموقع أعانك الله على المسؤولية الجديدة 😃

ببارك للأخ وجيه شرف الدين الترقية لدرجة الخبراء😄 باذن الله ستكون هناك ترقيات أخرى قريبا فى القسم 😃

بإضافة الدالة الشرطية IF على معادلة أخي سليم تم حل المطلوب الأخير... الملف المرفق Tasalsul.xlsx

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

بعد البحث عن الخلل وبعد تعب ومشقة للوصول للخطأ في الكود تبين أن الكود يعمل بشكل سليم والخطأ لديك في العمود BB وتم تصويبها تفضل المطلوب الدور الثانى 2019 علمى.xlsm

تفضل .... kanory.accdb

عذرا لم انتبه لمرفقك الا الان - كل زر امر يجب كتابه كود الصنف الخاص به على التاج لزر الامر هذا -يجب ان تكون اسم الصورة الخاصة بكل منتج برقم كود المنتج والذى سوف يتم كتابته على تاج زر الامر -يجب ان تكون الصور بامتداد bmp اتفضل يا سيدى التعديل على مرفقك Picture Bbutton - مثال-2 -.zip

وعليكم السلام-تفضل تنسيق شرطى.xlsx

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

انظر هذا وطبق .... عساه يكون المطلوب .... Test.rar

جرب هذا لعله المطلوب .... Lab 2019_5.rar

اخي الان يمكنك البحث عن اللرقم الذي تريده من بداية الرقم الاول من علي اليسار او اول رقمان علي اليسار وهكذا حتي اول تمانية ارقام علي اليسار والكود هو Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = Range("C3").Address Then If Target <> "" Then Range("C5:D1000").ClearContents s = Len(Range("C3")) If s > 0 Then x = 2 For i = 2 To 1000 If Sheets("Data").Cells(i, x) <> "" Then m = Sheets("Data").Cells(i, x).Address o = Left(Sheets("Data").Range(m), 1) oo = Left(Sheets("Data").Range(m), 2) ooo = Left(Sheets("Data").Range(m), 3) oooo = Left(Sheets("Data").Range(m), 4) ooooo = Left(Sheets("Data").Range(m), 5) oooooo = Left(Sheets("Data").Range(m), 6) ooooooo = Left(Sheets("Data").Range(m), 7) oooooooo = Left(Sheets("Data").Range(m), 8) If Range("C3").Text = o Or Range("C3").Text = oo Or Range("C3").Text = ooo Or Range("C3").Text = oooo Or Range("C3").Text = ooooo Or Range("C3").Text = oooooo Or Range("C3").Text = oooooo Or Range("C3").Text = ooooooo Or Range("C3").Text = oooooooo Then With Columns(4).Rows(2000).End(xlUp) .Offset(1, 0) = Sheets("Data").Cells(i, x) Cells(.Offset(1, 0).Row, 3) = Sheets("Data").Cells(i, x - 1) End With End If End If Next End If End If End If End Sub اما بخصوص المدي فيحدد عاموده ال X في سطر الذي هو x = 2 اما الذ يجدد الصف هذا السطر الخاص بالحلقة الدائرية For i = 2 To 1000 فيبدأ في البحث عن الرقم المطلوب في الصف 2 ثم 3 ونهاية بــ 1000 ارجو ان كون استطعت ايصال المعلومة تحياتي ارقام 2 (2).xlsm

🎈عيد سعيد🎈

نعم هذا ما قصدت .... بارك الله فيك أخي أبا جودي

السلام عليكم ورحمة الله تفضل الملف المرفق باستعمال الدالة DECALER (أو OFFSET) كحل أول... بن علية حاجي Stock.xlsx

يصبح الكود بهذه الصورة : On Error GoTo Err: DoCmd.RunCommand acCmdSaveRecord [Forms]![SandExpense_F]![ExpenseDate_Sub].[Form]![notes] = Me.notes2 Me.ExpenseDate_Sub.SetFocus DoCmd.GoToRecord , , acNewRec [ExpenseDate_Sub]![Amount2].SetFocus Exit Sub Err: MsgBox Error$ kan2.accdb

اخواني كل عام وانتم بخير جميعا بناء علي طلب احد الاخوة باللينك التالي https://www.officena.net/ib/topic/91148-نقل-واسترداد-البيانات-من-ملف-اكسل-الى-ملف-اكسيل-أخر/?fbclid=IwAR0xbxEnx7AZelkY6NQoXHeffLqB-RzI3Q_b1LqE8IcQdkcl1jbpWCjWm3I ولاكبر استفادة اردت الاجابة في مشاركة منفصلة شرح العمل:- افتح ملف" V2" اضغط علي الزر لاظهار الفورم اضعط علي زر استرداد بيانات من ملف اخر الكود المستخدم Sheets(1).Range("D6:G15") = "" mm = ActiveWorkbook.Name MyPath = ThisWorkbook.Path & "\v1.xlsm" 'On Error Resume Next Application.ScreenUpdating = False Application.DisplayAlerts = False Set Mybook = Workbooks.Open(Filename:=MyPath) m = Workbooks("v1.xlsm").Sheets(1).Range("D6:G15").Address Workbooks(mm).Sheets(1).Range(m).Formula = Workbooks("v1.xlsm").Sheets(1).Range("D6:G15").Formula Workbooks("v1.xlsm").Close Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox ("DONE") trans.rar

السلام عليكم جرب المرفق مع بعض الإضافات... الكلمة السرية لحماية الورقة هي: 123 بن علية حاجي فاتورة.rar