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

الحمد لله

النتيجة كانت 1025 تمت التجربة بنجاح .... واختفت المشكلة ... اصبحت الالوان تظهر كما يتم اختياره ... بدون مشاكل .... اصبحت تظهر الالوان المختارة .... ويؤسفني ان تبقى وحيدا يا صاحبي @مستفيد69 ههههه واشكرك اخي @Hamdi Edlbi-khalf على جهدك بارك الله فيك وكما اشكر استاذنا القدير @أبو إبراهيم الغامدي على اطروحاته الممتازة ...

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

للتخلص من هذه المشكلة؛ اكتب اسم الون (Blue, red, Green, Orange, Black) بدلا من رقمه وهذه قائمة بأسماء الألون مجمعة حسب اللون.. أسماء الألوان من W3Schools

Private Sub UserForm_Initialize() ListBox1.List = Range("A2:C11").Value End Sub Private Sub CommandButton1_Click() Dim c As Integer, i As Integer, t As Double Rem First Column In ListBox = 0 c = 0 For i = 0 To ListBox1.ListCount - 1 If ListBox1.List(i, c) <> Empty Then t = t + 1 Next i MsgBox t End Sub

السلام عليكم ورحمة الله وبركاته طرح في موضوع سابق موضوع رسائل الواتس اضع بين يديكم برنامج يقوم بارسال رسائل الواتس بدون حفظ الرقم في جهات الاتصال ويمكن استخدامه وتطويره لارسال رسائل للعملاء مثلا جربوه واعطونا انطباعكم حوله لتطويره والاستفادة منه ملاحظة هامة يجب تنصيب رنامج الواتس في جهازك ليعمل البرنامج هناك مدة زمنية وضعتها في الكود للتنفيذ مقدارها 40 يمكنك تغييرها ليتناسب مع سرعة جهازك ...... الطريقة سهله أوضحها باختصار مع اقتران كل شرح بالصورة ..... أولا : الذهاب للرابط https://www.whatsapp.com/download وتحميل برنامج الواتس حسب نسخة الويندوز لديك ( 64 - 32 )bit ثانيا: تشغيل برنامج الواتس والتسجيل عن طريق حسابك في الواتس وذلك بمسح البركود الظاهر في البرنامج من خلال البرنامج ( حسب الصورة ) ثالثا : عند اول تشغيل تظهر لك من خلال المتصفح رسالة بالسماح بفتح الارتباط بهذا النوع ( ضع علامة صح مثل الصورة ) رابعا : عند عمل البرنامج للمرة الثانية لا يحتاج تكرار هذه العمليات ( فقط انتظر اتمام المهمة ) هناك في الكود زمن افتراضي وضعته هو 40 ثانية أن رأيت جهازك والنت سريع حاول تقليل الزمن لكسب سرعة في الارسال أو العكس بالعكس تسجيل الارقام بالصيغة الدولية .... منتظر انطباعاتكم حول البرنامج ؟؟؟؟ WhatsApp_kan.accdb هنا تجدون الموضوع السابق ......

بالبحث والاستكشاف لساعات ، ياما نلتفت ، واذا بعمود الفجر قد ظهر 🙂 جعفر

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

السلام عليكم 🙂 اخوي ابوخليل ، الله يعطيك الصحة والعافية ، شغل جميل وخفيف 🙂 اخوي سامي ، طبعا هذه ملاحظات عامة ، واهميتها هي لتسريع عمل البرنامج ، وتجنب الاخطاء 🙂 تركت ملاحظتي سابقا والآن الى التفاصيل من واقع مرفقك في مشاركتك الاخيرة اعلاه ، وبدون ترتيب: الكود : 1. كل مكان عندك الامر Dcount ، مثل DCount("aaa","ttt") او DCount("aaa","ttt","ccc="& ddd) ، احذف aaa واستعمل النجمة * ، يعني Dcount("*","ttt") هذا يعطيك نفس النتيجة ، ولكنه اسرع ، لأنه يطلب عدد السجلات دون ان يعمل فرز لإسم الحقل وحساب عدد سجلاته. 2. كل مكان عندك الامر DCount("aaa","ttt","ccc="& ddd) ، الحقل ccc يجب ان يكون مفرس في الجدول (تسمح بالتكرار او لا ، يعتمد على دور الحقل في الجدول) ، وهذا ينطبق على الاوامر Dlookup و Dmax وووو ، فالمثال التالي ، الحقل ename يجب ان يكون مفهرس DCount("ename", "tblUsersName", "[ename]= '" & Trim(Me.ename) & "'") 3. في كل مكان في الكود ، اذا كنت ستستخدم اسم احد حقول النموذج ، فاستخدم كلمة .Me او !Me قبل الاسم ، حتى بعد سنين لما ترجع للكود ، تعرف ان هذا ليس متغير وانما هو اسم حقل. 4. في راس كل صفحة الكود استخدم السطرين Option Compare Database Option Explicit حتى تضطر ان تصرح عن المتغير المستعمل عن طريق Dim ، حتى يعمل الكود بطريقة اسرع ، وانت تعرف نوع المتغير وتعرف مكان الخطأ. 5. عند كتابة الكود ، وبين كل فترة واخرى استعمل Debug>Compile ، حتى ترى اذا كان الكود فيه اخطاء (انا عملت اختصار له في القائمة) ، انظر احد الاخطاء الموجود عندك مثلا: . 6. من الجميل عمل تنسيق الكود ، حتى تعرف من رؤيته ، بداية ونهاية الحلقات ، مثلا ، بدلا عن Private Sub cmdremove_Click() If MsgBox("هل تريد حذف السجل?", _ vbExclamation + vbOKCancel, _ "warning") = vbOK Then Me.deleteBox = True Else Exit Sub End If Me.Requery End Sub اكتب Private Sub cmdremove_Click() If MsgBox("هل تريد حذف السجل?", _ vbExclamation + vbOKCancel, _ "warning") = vbOK Then Me.deleteBox = True Else Exit Sub End If Me.Requery End Sub 7. اختصر الكلمات الطويلة ، حتى تستطيع ان تقرأها بسهولة : فبدلا عن Forms!frmdevDetails!frmDetails!userType.Enabled = False Forms!frmdevDetails!frmDetails!users.Enabled = False Forms!frmdevDetails!frmDetails!receiveDate.Enabled = False Forms!frmdevDetails!frmDetails!idOffice.Enabled = False Forms!frmdevDetails!frmDetails!dateHireEnd.Enabled = False Forms!frmdevDetails!frmDetails!returnDate.Enabled = True استخدم with Forms!frmdevDetails!frmDetails !userType.Enabled = False !users.Enabled = False !receiveDate.Enabled = False !idOffice.Enabled = False !dateHireEnd.Enabled = False !returnDate.Enabled = True end with وبدلا عن Private Sub zerClose_Click() If IsNull(Forms!frmdevDetails!frmDetails!receiveDate) And Not IsNull(Forms!frmdevDetails!frmDetails!users) Then MsgBox "لطفاً أدخل تاريخ التسليم" ElseIf Forms!frmdevDetails!frmDetails!userType = 4 And IsNull(Forms!frmdevDetails!frmDetails!dateHireEnd) Then MsgBox "لطفاً أدخل تاريخ نهايةالإعارة" ElseIf IsNull(Forms!frmdevDetails!frmDetails!userType) And Not IsNull(Forms!frmdevDetails!frmDetails!receiveDate) Then MsgBox "لطفاً أدخل نوع المستخدم" ElseIf IsNull(Forms!frmdevDetails!frmDetails!users) And Not IsNull(Forms!frmdevDetails!frmDetails!receiveDate) Then MsgBox "لطفاً أدخل المستخدم" Exit Sub Else DoCmd.Close End If End Sub استخدم Private Sub zerClose_Click() with Forms!frmdevDetails!frmDetails If IsNull(!receiveDate) And Not IsNull(!users) Then MsgBox "لطفاً أدخل تاريخ التسليم" ElseIf !userType = 4 And IsNull(!dateHireEnd) Then MsgBox "لطفاً أدخل تاريخ نهايةالإعارة" ElseIf IsNull(!userType) And Not IsNull(!receiveDate) Then MsgBox "لطفاً أدخل نوع المستخدم" ElseIf IsNull(!users) And Not IsNull(!receiveDate) Then MsgBox "لطفاً أدخل المستخدم" Exit Sub Else DoCmd.Close End If end with End sub 8. لا تستعمل الكلمات المحجوزة للأكسس في تسمية اي كائنات او متغيرات ، واذا اضطررت ان تستعملها: مثلا: لا تستعمل Me.section ، وانما استعمل Me![section] الاستعلامات : 9. كل مرة نستخدم معيار او فرز ، وفي اي مكان في البرنامج ، يجب فهرست الحقل ، مثل : . وحتى في مربع القائمة المنسدلة : . الحقل UsrType يجب ان يكون مفهرس . 10. لما تربط النموذج الرئيسي بالنموذج الفرعي ، فيجب ان يكون بينهما علاقة ، وكلا الحقلين يجب ان يكونا مفهرسين : . 11. الصور في البرنامج ، ولحفظ حجم البرنامج صغيرا ، يجب ان تكون الصور موجودة في مجلد في الكمبيوتر ، وليست في الجداول ولا مضمنه في النماذج والتقارير ، وانا استعمل المجلدات بهذه الطريقة ، فحتى لما تنقلها لكمبيوتر آخر ، كل شيء يشتغل بدون مشاكل: . وقد عملت نسخة من الصور الثلاث الموجودة في التقارير ، ووضعتها في المجلد images ، وفي التقارير ، تعمل تغيير في الاعدادات ، بدلا عن Embedded ، نعملها Linked : . حجم ملفك الاصل بعد الضغط والاصلاح: . ثم لربط الصور بالتقارير ، انظر الصور موجودة في اي قسم من التقرير ، وهنا نرى انها في رأس التقرير Report Header ، فنستخدم حدث "عند التنسيق" لهذا القسم: انقر على الخط المكتوب عليه Report Header ، ثم استعمل حدث "عند التنسيق" ، والكود سيكون : Private Sub ReportHeaderSection_Format(Cancel As Integer, FormatCount As Integer) On Error GoTo err_ReportHeaderSection_Format Me.img_Ministry_of_Education.Picture = Application.CurrentProject.Path & "\images\Ministry_of_Education.jpg" Me.img_Oman_Vision_2040.Picture = Application.CurrentProject.Path & "\images\Oman_Vision_2040.jpg" Me.img_Quality_Management_System.Picture = Application.CurrentProject.Path & "\images\Quality_Management_System.jpg" Exit_ReportHeaderSection_Format: Exit Sub err_ReportHeaderSection_Format: If Err.Number = 2220 Then 'image not found Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description Resume Exit_ReportHeaderSection_Format End If End Sub . عليه اصبح حجم الملف ، حوالي النصف : . 12. لما تكون عندك علاقة في الاستعلام بين الجداول ، بهذه الطريقة مثلا : . ففعلا انت محتاج الى عمل علاقة بين الجداول (خارج الاستعلام) ، والتي ستجبرك على عمل فهرسة مسبقا لحقل من جانب واحد ، او عمل فهرسة للجانبين ، بمعنى: اذا عملت فهرسة لحقل في جدول واحد ، ثم عملت علاقة بين هذا الحقل A وحقل B في جدول آخر ، فيمكنك ان لا تفهرس الحقل B في الجدول ، لأن العلاقة تلقائيا تجعله مفهرسا ، والاكسس يفهم هذا. بعض الملاحظات اعلاه تقدر تقوم بها مباشرة الآن ، ولكن لا تعمل العلاقات إلا بعد ان يعطيك اخوي ابوخليل الضوء الاخضر 🙂 جعفر

سرتني مساعدتك الحمد لله أللهم صل على سيدنا محمد وعلى آله وصحبه وسلم

الف شكر لحضرتك فعلا تم حل المشكلة جزاك الله خيرا يارب يحفظك احترامى وتقديرى اخى الكريم

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

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

الآن لو سمحت جرب المرفق .... FinalcolorisingARB.accdb

بشكرك جدا ع الرد و الكود الجامد

شكراااااااااااااااااااا جدااااااااااااااا ربنا يبارك فيكم

Press Alt + F11 to login VBE editor From Insert menu select Module Paste the code Back to the worksheet and press Alt + F8 and click Run th execute the code

Sub Test() Dim r As Long, m As Long Application.ScreenUpdating = False r = 1: m = 7 Do Cells(m, 4).Resize(, 6).Value = Application.Transpose(Cells(r, 1).Resize(6).Value) m = m + 1: r = r + 6 Loop Until r >= Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = True End Sub

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

غير اتجاه القراءة في مربع النص إلى (من اليسار إلى اليمين)

اشكرك للمرة الثانية الكود استخدمه والطريقة Ctrl+p معلومة لدي ايضا اردت معرفة ان كان هناك معادلة لاني لا احب الاكواد فالاستخدام فلا مشكلة باذن الله وشكرا للمتابعة والرد

The question is not related to the main question Anyway this line will print the activesheet ActiveSheet.PrintOut You asked for a fomula to print (that is too weird) Generally you can press Ctrl + P to print without any formulas or codes

Try using semi-colon instead of comma like that ;

In Data tab select data validation and select Custom and finally insert a formula like that =OR((A1="A"),AND(A1>=0,A1<=70)) Change the A letter with the absent character in arabic

وعليكم السلام 🙂 لاحظ هذا المثال: استعملنا اسم الحقل الذي في النموذج ، ولم نستخدم اسم الحقل "مصدر المعلومات" . . بينما كان يجب ان نستخدم اسم الحقل "مصدر المعلومات" . جعفر

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

Thank you very much my dear brother, it works perfectly i really appreciate your kind help جزاك الله خيرا

تفضل ... كما يمكنك الإستعانة بهذا الرابط How To Create A Searchable Drop Down List In Excel? قائمة منسدلة1.xlsx

First unprotect the worksheet Select cell B8 which is related to the scroll bar form control > Right-click the cell > Format Cells > Protection tab > Uncheck the Locked option Finally protect the worksheet again

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته لا بد أن يكون أسم المسار الذي تضع فيه البرنامج بالإنجليزي أو تغير لعة الوندوز إلى العربية

You can directly use this line if you don't care about empty items MsgBox ListBox1.ListCount

You can change number 1 in this line with 3 .Range("A3").Resize(x, 1) = temp

في مربع النص لا تنسى علامة ال = =Sum([Field1])

السلام عليكم و رحمة الله و بركاته المرفق يحتوي على كل ما يحتاجه المبرمج و يستحق الإكتشاف أفكار جديدة و رائعة , الملف منقول للأمانة تقبلوا تحياتي VBA Task Dial.accdb

السلام عليكم يمكنك استخدام هذه المعادلة لإيجاد مجموع الكميات بالعمود D بداية من الخلية D2 سحباً للأسفل =IF(COUNTIF($B$2:B2,B2)=1,SUMIF($B:$B,$B2,$C:$C),"") وهذه معادلة النسبة المئوية بالعمود E =C2/VLOOKUP(B2,$B$2:$D$2000,3,0) تجربة1.xlsx

تفضل حسب البيانات الموجودة في الجدول ولو زدتنا زدناك Database3.accdb

هذا لتوضيح الفكره بشكل عملى مرفق ملف الفكره tree.accdb

يا صاحب ابتسامة الجميلة نحن لا نهاجم على اي شخص كلكم احباءنا في الله ونبحكم في الله اتفضل انا عملت كوبي باست لاحد مشاركاتي قبل يوم اتفضل الصق هذا الكود في وحدة نمطية Option Compare Database Public Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Public Sub HideAccess() Call ShowWindow(Access.hWndAccessApp, 0) End Sub Public Sub ShowAccess() Call ShowWindow(Access.hWndAccessApp, 5) End Sub وفي نموذج عند تحميل او عند فتح اكتب HideAccess للاخفاء و ShowAccess للاظهار من جديد وهذا هو رابط الموضوع

السلام عليكم ورحمة الله وبركاته عملت مثال على الرابط التالي وبه مرفق يعمل على 32 بت و 64 بت: http://www.officena.net/ib/topic/64325-مثال-يعمل-على-اكسس-32-بت-و-64-بت/ جعفر

استبدل الكود السابق بهذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub If Not Intersect(Target, Range("D6:D115")) Is Nothing Then If Target.Value = 4 Then Target.Offset(, 2).ClearContents End If End Sub

المسألة متعلقة بخصائص RichBox كونها محدودة؛ حتى مع الألون!

اصبحنا (وحيدين 🤣🤣) نعم ولما رايت المرفق الجديد وجدته ملف اكسل ومختلف عن ملفنا وانا لا افهم شيء في اكسل 😀 لكن لما رايت الكبسة البنفسجية تقول (اضربني ) ضربتها 😁 وخرجت رسالة (1025) واعدت تشغيل البرنامج ونفس النتيجة بانتظار (الوحيد الثاني 😅) الاستاذ ابو البشر