Moosak

السلام عليكم ورحمة الله وبركاته .. 🙂 نزولا عند رغبة شيخنا الفاضل @ابوخليل تم إضافة تحسين بسيط على دالة التفقيط المبسطة لتعميم الفائدة .. طبعا الدالة كانت تأخذ 3 أرقام من كسر العملة هكذا ( 143.487 ) وهذا ينطبق على بعض العملات كالريال العماني والبيسة العمانية بينما أن هناك الكثير من العملات تعتمد 2 رقمين لكسر العملة مثال الريال والهللة السعودية والجنيه والقرش المصري هكذا ( 123.45 ) والتعديل الذي تم إجراؤه هو إضافة معامل رابع للدالة للتحكم في هذا الاختلاف واختيار عدد أرقام كسر العملة 2 أو 3 حسب الحاجة .. بدون إطالة إليكم الدالة كاملة .. وكذلك تم إضافة ملف جاهز ليبين طريقة الاستخدام : 🙂 Option Compare Database Option Explicit Function NoToTxt(TheNo As Double, _ MyCur As String, _ MySubCur As String, _ Optional FractionDigits As Integer = 3 _ ) As String '---------------------------------- ' دالة التفقيط المحسنة ' TheNo : المبلغ ' MyCur : العملة الرئيسية ' MySubCur : جزء العملة ' FractionDigits : عدد أرقام جزء العملة 2 أو 3 '---------------------------------- ' : أمثلة على الاستخدام ' NoToTxt(15.436, "ريال عماني", "بيسة") ' NoToTxt(15.43, "ريال", "هللة", 2 ) ' NoToTxt2(15.436, "ريال", "بيسة", 3) '---------------------------------- Dim MyArry1(0 To 9) As String Dim MyArry2(0 To 9) As String Dim MyArry3(0 To 9) As String Dim Myno As String Dim GetNo As String Dim RdNo As Integer Dim My100 As String Dim My10 As String Dim My1 As String Dim My11 As String Dim My12 As String Dim GetTxt As String Dim Mybillion As String Dim MyMillion As String Dim MyThou As String Dim MyHun As String Dim MyFraction As String Dim MyAnd As String Dim i As Integer Dim ReMark As String Dim IntegerPart As Double Dim FractionPart As Long Dim ScaleNo As Double ' عدد خانات الكسر المسموح بها ' الدالة الحالية تقرأ الجزء العشري كمجموعة من 3 أرقام، لذلك الحد الأعلى 3 If FractionDigits < 0 Then FractionDigits = 0 If FractionDigits > 3 Then FractionDigits = 3 If Abs(TheNo) > 999999999999.999 Then Exit Function If TheNo < 0 Then TheNo = TheNo * -1 ReMark = "عليه مبلغ " Else ReMark = "له مبلغ " End If If TheNo = 0 Then NoToTxt = "صفر" Exit Function End If MyAnd = " و" MyArry1(0) = "" MyArry1(1) = "مائة" MyArry1(2) = "مائتان" MyArry1(3) = "ثلاثمائة" MyArry1(4) = "اربعمائة" MyArry1(5) = "خمسمائة" MyArry1(6) = "ستمائة" MyArry1(7) = "سبعمائة" MyArry1(8) = "ثمانمائة" MyArry1(9) = "تسعمائة" MyArry2(0) = "" MyArry2(1) = " عشر" MyArry2(2) = "عشرون" MyArry2(3) = "ثلاثون" MyArry2(4) = "اربعون" MyArry2(5) = "خمسون" MyArry2(6) = "ستون" MyArry2(7) = "سبعون" MyArry2(8) = "ثمانون" MyArry2(9) = "تسعون" MyArry3(0) = "" MyArry3(1) = "احدى" MyArry3(2) = "اثنان" MyArry3(3) = "ثلاثة" MyArry3(4) = "اربعة" MyArry3(5) = "خمسة" MyArry3(6) = "ستة" MyArry3(7) = "سبعة" MyArry3(8) = "ثمانية" MyArry3(9) = "تسعة" '====================== ' تجهيز الرقم حسب عدد الخانات المطلوبة بعد الفاصلة ' مثال: ' FractionDigits = 2 يجعل 15.436 تقرأ كـ 15.44 ' FractionDigits = 3 يجعل 15.436 تقرأ كـ 15.436 TheNo = Round(TheNo, FractionDigits) IntegerPart = Fix(TheNo) If FractionDigits = 0 Then FractionPart = 0 Else ScaleNo = 10 ^ FractionDigits FractionPart = CLng(Round((TheNo - IntegerPart) * ScaleNo, 0)) End If ' معالجة حالة التقريب التي قد ترفع الجزء العشري إلى 100 أو 1000 If FractionDigits > 0 Then If FractionPart >= ScaleNo Then IntegerPart = IntegerPart + 1 FractionPart = 0 End If End If ' الجزء الصحيح 12 رقم + الجزء العشري دائمًا 3 أرقام داخليًا ' عند اختيار خانتين مثلًا 44 يتم تخزينها كـ 044 حتى تُقرأ أربعون وأربعة GetNo = Format(IntegerPart, "000000000000") & "." & Format(FractionPart, "000") i = 0 '=============== Do While i < 16 My100 = "" My10 = "" My1 = "" My11 = "" My12 = "" GetTxt = "" If i < 12 Then Myno = Mid$(GetNo, i + 1, 3) Else Myno = Mid$(GetNo, i + 2, 3) End If If Val(Mid$(Myno, 1, 3)) > 0 Then RdNo = Val(Mid$(Myno, 1, 1)) My100 = MyArry1(RdNo) RdNo = Val(Mid$(Myno, 3, 1)) My1 = MyArry3(RdNo) RdNo = Val(Mid$(Myno, 2, 1)) My10 = MyArry2(RdNo) If Val(Mid$(Myno, 2, 2)) = 11 Then My11 = "احدى عشر" If Val(Mid$(Myno, 2, 2)) = 12 Then My12 = "اثني عشر" If Val(Mid$(Myno, 2, 2)) = 10 Then My10 = "عشرة" If Val(Mid$(Myno, 1, 1)) > 0 And Val(Mid$(Myno, 2, 2)) > 0 Then My100 = My100 & MyAnd End If If Val(Mid$(Myno, 3, 1)) > 0 And Val(Mid$(Myno, 2, 1)) > 1 Then My1 = My1 & MyAnd End If GetTxt = My100 & My1 & My10 If Val(Mid$(Myno, 3, 1)) = 1 And Val(Mid$(Myno, 2, 1)) = 1 Then GetTxt = My100 & My11 If Val(Mid$(Myno, 1, 1)) = 0 Then GetTxt = My11 End If If Val(Mid$(Myno, 3, 1)) = 2 And Val(Mid$(Myno, 2, 1)) = 1 Then GetTxt = My100 & My12 If Val(Mid$(Myno, 1, 1)) = 0 Then GetTxt = My12 End If If i = 0 And GetTxt <> "" Then If Val(Mid$(Myno, 1, 3)) > 10 Then Mybillion = GetTxt & " مليار" Else Mybillion = GetTxt & " مليارات" If Val(Mid$(Myno, 1, 3)) = 1 Then Mybillion = " مليار" If Val(Mid$(Myno, 1, 3)) = 2 Then Mybillion = " ملياران" End If End If If i = 3 And GetTxt <> "" Then If Val(Mid$(Myno, 1, 3)) > 10 Then MyMillion = GetTxt & " مليون" Else MyMillion = GetTxt & " ملايين" If Val(Mid$(Myno, 1, 3)) = 1 Then MyMillion = " مليون" If Val(Mid$(Myno, 1, 3)) = 2 Then MyMillion = " مليونان" End If End If If i = 6 And GetTxt <> "" Then If Val(Mid$(Myno, 1, 3)) > 10 Then MyThou = GetTxt & " الف" Else MyThou = GetTxt & " الاف" If Val(Mid$(Myno, 1, 3)) = 1 Then MyThou = " الف" If Val(Mid$(Myno, 1, 3)) = 2 Then MyThou = " الفان" End If End If If i = 9 And GetTxt <> "" Then MyHun = GetTxt If i = 12 And GetTxt <> "" Then If FractionDigits > 0 Then MyFraction = GetTxt End If End If End If i = i + 3 Loop '============================ If Mybillion <> "" Then If MyMillion <> "" Or MyThou <> "" Or MyHun <> "" Then Mybillion = Mybillion & MyAnd End If End If If MyMillion <> "" Then If MyThou <> "" Or MyHun <> "" Then MyMillion = MyMillion & MyAnd End If End If If MyThou <> "" Then If MyHun <> "" Then MyThou = MyThou & MyAnd End If End If If MyFraction <> "" Then If Mybillion <> "" Or MyMillion <> "" Or MyThou <> "" Or MyHun <> "" Then NoToTxt = ReMark & Mybillion & MyMillion & MyThou & MyHun & " " & MyCur & MyAnd & MyFraction & " " & MySubCur & " فقط" Else NoToTxt = ReMark & MyFraction & " " & MySubCur & " فقط" End If Else NoToTxt = ReMark & Mybillion & MyMillion & MyThou & MyHun & " " & MyCur & " فقط" End If End Function NoToTxt.accdb

يا كرم الله 😃🌹 جمال .. وتحفة فنية .. تبارك الله 😊✌ لحد ما يماط اللثام عن الأسرار .. 3 أسئلة تدور في خاطري .. 😎 1- القضاء على الترميش بشكل نهائي .. 2- تدوير الصور . 3- تحريك أكثر من عنصر في نفس الوقت بشكل تفاعلي عجيييب . وننتظر فرج الله 🌼 أفكار شاطحة خارج الصندوق .. تستحق وسام الإبداع بحق 😊👌

السلام عليكم ورحمة الله وبركاته 🙂🖐 يقول المثل : أن تأتي متأخرا خير من أن لا تأتي 😅✌ بعد جهد جهيد إنتهيت من تصميم نظام تسجيل دخول + نظام صلاحيات متطور كلما أخطو فيه خطوة أجد أنه ناقص وتطلع أفكار جديدة .. 😅👊 لذلك قلت سأنزلها كما هي الآن .. حاولت تبسيطه للمستخدم والمستفيدين منه لاحقا قدر المستطاع .. وسأبدأ بواجهة تسجيل الدخول المتواضعة : المزايا : حفظ بيانات دخول المستخدم (اختياري) الدخول مباشرة بمجرد كتابة كلمة المرور بشكل صحيح (تسريع عملية الدخول) ملاحظة : جميع كلمات المرور في البرنامج : 123 ثانيا الواجهة الرئيسية : يتم تطبيق الصلاحيات للمستخدم بمجرد تسجيل الدخول .. ثالثا : إدارة المستخدمين هنا يتم إدارة جميع ما يتعلق بمستخدمي البرنامج ( إضافة ، تعديل ، حذف ، تعيين الصلاحيات ) رابعا : إدارة مجموعات العمل والصلاحيات لكل مجموعة هنا يتم ضبط الصفحات المسموح لكل مجموعة دخولها والصلاحيات الخاصة بكل صفحة .. ومثل ماهو واضح يمكن إضافة النماذج أو إزالتها كما يحلو لك وبعد ضبط مجموعات العمل يتم تعيين كل مستخدم للمجموعة الخاصة به ، ويمكن عمل مجموعة خاصة لشخص واحد فالخيارات غير محدودة .. 🙂 الآن يمكنك الخروج من البرنامج ثم تجربة تسجيل الدخول باسم المستخدمين المسجيلين في البرنامج للاستمتاع بتجربة الصلاحيات الممنوحة لكل مستخدم 😊 وبعد الدخول للصفحات يتم تطبيق الصلحيات الخاصة بالنموذج أيضا .. وبقية الصلاحيات ستظهر حسب الزر الذي يتم الضغط عليه مزايا إضافية موجودة في البرنامج .. ولها علاقة بالأمان أيضا .. نظام النسخ الاحتياطي وله إعدادات خاصة به (نسخ احتياطي يدوي أو تلقائي ) وهو موجود في صفحة إعدادات البرنامج : ولكل مستخدم مجموعة خيارات يمكنه التحكم بها مثل ( تغيير كلمة المرور ، التشغيل عند إقلاع الجهاز ، إنشاء اختصار في سطح المكتب ، حفظ بيانات التسجيل لتسريع الدخول للبرنامج) هذه هي أهم الميزات التي يحتويها البرنامج 🙂 ولفتح البرنامج في وضع التصميم ، حتى هذي سهلة للمبرمج 😅🖐 في صفحة تسجيل الدخول وكذلك الصفحة الرئيسية يوجد هذا الزر الخاص بالمبرمج >> بعد الضغط عليه >> أدخل كلمة المرور : 123 ويمكنك تغييرها من الكود الخاص بالزر .. بتظهر لك هذي النافذة الخاصة بالمبرمج فقط : وأهم ما فيها : (1) عرض الشريط العلوي ونافذة الأكسس >> بعد تفعيله تحفظ وتشغل الماكرو وبتنفتح عندك واجهة الأكسس >> أعد تشغيل البرنامج من جديد للحصول على جميع الميزات. (2) اسم نموذج البداية >> وهو أو نموذج بيشتغل معاك في البرنامج >> وهذا يسهل على المبرمج تطبيق النظام على أي برنامج آخر 🙂 (3) اسم البرنامج (واللي ييظهر في الشريط العلوي للأكسس) : (4) رقم الإصدار (نسخة البرنامج) وتاريخها >> ويمكن الاعتماد عليها لتحديث البرنامج لاحقا .. (5) إدارة نماذج الصلاحيات >> وهي النماذج اللي ستسمح بإعطاء صلاحيات لدخولها للبرنامج .. وكذلك تعطي كل نموذج اسم صديق للمستخدم وسيتم استخدام المسمى الحقيقي للنموذج داخليا .. وهكذا أكون شرحت لكم أهم المميزات ويتبقى نقطة مهمة وهي : يمكن للمبرمج الآن الاستفادة من هذا الملف فهو قاعدة جاهزة لإنطلاق في تصميم برنامجك الخاص .. جميع الأكواد الخاصة بالصلاحيات ستجدها في الموديول التالي : وأهم ما ستحتاج معرفته في كيفية تطبيق الصلاحيات ذكرته في الملاحظات المكتوبة أول الموديول : ' (1) : لتطبيق صلاحية فتح النماذج وصلاحيات الإضافة والتعديل والحذف تضع الأسطر التالية أول الأكواد في حدث فتح النموذج '------------------------------------------------------------------------------- 'Private Sub Form_Open(Cancel As Integer) ' ' فحص صلاحة دخول النموذج ' Cancel = Not Permission_OpenForm(Me.Name, True) ' ' تطبيق صلاحيات : الإضافة / التعديل / الحذف ' Apply_Addition_Edits_Delete_Permissions (Me.Name) 'End Sub '------------------------------------------------------------------------------- ' (2) : لتطبيق صلاحيات الطباعة والاستيراد والتصدير داخل نموذج معين تكتب هذه الأسطر لمعرفة وجود الصلاحة من عدمها ' : وكل سطر من هذه الصلاحيات يرجع لك النتيجة كما يلي ' True : مسموح ' False : ممنوع '------------------------------------------------------------------------------- ' 1- فحص صلاحية الطباعة (True/False) ' Permission_Print(Me.Name , True) ' |_>> (True/False) : هذه الجزئية اختيارية لعرض رسالة تنبيه عند عدم وجود صلاحية من عدمها ' 2- فحص صلاحية الاستيراد (True/False) ' Permission_Import(Me.Name , True) ' |_>> (True/False) : هذه الجزئية اختيارية لعرض رسالة تنبيه عند عدم وجود صلاحية من عدمها ' 3- فحص صلاحية التصدير (True/False) ' Permission_Export(Me.Name , True) ' |_>> (True/False) : هذه الجزئية اختيارية لعرض رسالة تنبيه عند عدم وجود صلاحية من عدمها '------------------------------------------------------------------------------- والنماذج الموجودة في البرنامج مع أزرارها تم تطبيق الأكواد عليها بشكل عملي << راجعها وأدرسها لمعرفة كيفية عملها .. وهي سهلة يسيرة بفضل الله 🙂 وهذا مثال عملي لتطبيق الصلاحية على زر الطباعة (فتح التقرير) مثلا : وهكذا بقية الصلاحيات (اطلع على بقية الموديول) تم تحويلها لأسطر قليلة بسيطة للاستفادة منها بكل يسر .. 🙂 وأخيرا تحميل البرنامج :: Moosak ‏‏Login System with permissions 1.0.zip :: وآخر دعوانا أن الحمد لله رب العالمين ::

الشكر موصول لك أخي @AMINYOUSIF على المتابعة 🙂 بالنسبة لسؤالك الأول فهي تعمل كما كانت سابقا .. هل تظهر عندك بشكل مختلف ؟ بالنسبة لهذه الرسالة فهي للأسف بسبب محدوديات الخدمات المجانية المقدمة من قبل شركة جوجل أو بسبب الضغط على السيرفر في تلك الأثناء .. جوجل تبغى تطلع عينك علشان تشترك ويحسنوا لك الخدمة 😅🖐 وحلها إما أنك تحاول مجدد بعد دقيقة أو تجي في وقت لاحق وتحاول مجددا .

تم معالجة المشكلة ولله الحمد .. 👍🙂 تم نقل الصفحة لموقع آخر يعمل بشكل مجاني .. وهذا هو الرابط الجديد وقد تم تحديثه أيضا في المشاركة الأساسية : https://script.google.com/macros/s/AKfycbwNEw1mNkjqgRndgyLnC89MLYI2C6UiEE-jlRNET0v__nAK377nD8WFkGHnmaTIvxgx/exec

أقترح تمديد المدة إلى نهاية شهر 4 ... مزنوقين !! 😅🖐

وعليكم السلام ورحمة الله وبركاته 🙂 تفضل أخي بلالشريط متحرك.mdb

أرى الحل أنك تستغني عن المكتبات تماما بتعريف المتغيرات كـ Object .. رجعت لنفس الأداة وكتبت له : والنتيجة : Private Sub cm_ToExcel_Click() ' تعلن عن المتغيرات المطلوبة Dim stDocName As String Dim Q As Integer Dim objFileDialog As Object ' كائن مربع حوار الملفات (يتم تعريفه كـ Object لعدم استخدام المكتبات) Dim varFilePath As Variant ' المسار الكامل للملف الذي سيتم حفظه (يتم تعريفه كـ Variant لاستقبال قيمة من مربع الحوار) Dim fso As Object ' كائن نظام الملفات للتحقق من وجود محرك الأقراص (يتم تعريفه كـ Object لعدم استخدام المكتبات) Dim drv As Object ' كائن محرك الأقراص (يتم تعريفه كـ Object لعدم استخدام المكتبات) Dim blnDriveEExists As Boolean ' علامة منطقية للتحقق مما إذا كان محرك الأقراص E موجودًا وجاهزًا Dim strDefaultPath As String ' المسار الافتراضي الذي سيتم عرضه في مربع الحوار ' تعيين معالج الأخطاء للانتقال إلى تسمية Err_cm_ToExcel_Click في حالة حدوث خطأ On Error GoTo Err_cm_ToExcel_Click ' بناء اسم المستند بناءً على اسم الجدول وقيمة حقل [Year_name] stDocName = "tbl_Teacher" & [Year_name] ' حساب عدد السجلات في جدول tbl_Teacher Q = DCount("*", "tbl_Teacher") ' التحقق مما إذا كانت هناك سجلات (أكثر من صفر) لتصديرها If Q > 0 Then ' -------------------------------------------------------------------- ' الجزء الخاص بالتحقق من وجود محرك الأقراص E وتعيين المسار الافتراضي ' -------------------------------------------------------------------- ' إنشاء كائن FileSystemObject بدون استخدام مكتبات (Late Binding) ' هذا يسمح بالتحقق من محركات الأقراص دون الحاجة إلى إضافة مرجع لمكتبة Microsoft Scripting Runtime Set fso = CreateObject("Scripting.FileSystemObject") blnDriveEExists = False ' تهيئة العلامة إلى False ' التكرار عبر جميع محركات الأقراص المتاحة للتحقق من وجود محرك الأقراص E For Each drv In fso.Drives If drv.DriveLetter = "E" Then ' إذا كان حرف محرك الأقراص هو "E" If drv.IsReady Then ' والتأكد من أن محرك الأقراص جاهز للاستخدام (ليس فارغًا أو غير متصل) blnDriveEExists = True ' تعيين العلامة إلى True Exit For ' الخروج من الحلقة بمجرد العثور على محرك الأقراص E الجاهز End If End If Next drv ' تعيين المسار الافتراضي لمربع الحوار بناءً على نتيجة التحقق If blnDriveEExists Then strDefaultPath = "E:\" ' إذا كان E موجودًا وجاهزًا، استخدمه كمسار افتراضي Else ' إذا لم يكن E موجودًا أو جاهزًا، استخدم مسار المشروع الحالي كمسار افتراضي strDefaultPath = CurrentProject.Path End If ' تحرير كائنات نظام الملفات لتحرير الذاكرة Set fso = Nothing Set drv = Nothing ' -------------------------------------------------------------------- ' الجزء الخاص بعرض مربع حوار حفظ الملف للسماح للمستخدم باختيار الموقع ' -------------------------------------------------------------------- ' إنشاء كائن مربع حوار الملفات (Application.FileDialog) بدون استخدام مكتبات (Late Binding) ' 2 يمثل msoFileDialogSaveAs (قيمة ثابتة لمربع حوار حفظ باسم) Set objFileDialog = Application.FileDialog(2) ' تهيئة خصائص مربع الحوار With objFileDialog .Title = "اختر مكان حفظ ملف الإكسل" ' تعيين العنوان الذي يظهر في أعلى مربع الحوار .InitialFileName = stDocName & ".xls" ' تعيين الاسم الافتراضي للملف الذي سيتم حفظه .InitialFolder = strDefaultPath ' تعيين المجلد الافتراضي الذي سيتم فتحه عند ظهور مربع الحوار .ButtonName = "حفظ" ' تعيين النص الذي يظهر على زر الحفظ في مربع الحوار .Filters.Clear ' مسح أي فلاتر ملفات موجودة مسبقًا .Filters.Add "ملفات إكسل (*.xls)", "*.xls" ' إضافة فلتر لملفات الإكسل القديمة (Excel 97-2003) .Filters.Add "جميع الملفات (*.*)", "*.*" ' إضافة فلتر لجميع أنواع الملفات .FilterIndex = 1 ' تعيين الفلتر الأول (ملفات إكسل) كفلتر افتراضي ' عرض مربع الحوار والتحقق مما إذا كان المستخدم قد ضغط على زر "حفظ" If .Show = -1 Then ' -1 يعني أن المستخدم ضغط على زر "حفظ" (OK) ' الحصول على المسار الكامل للملف المحدد من قبل المستخدم varFilePath = .SelectedItems(1) ' تصدير البيانات من جدول tbl_Teacher إلى ملف الإكسل بالمسار الذي اختاره المستخدم ' 0 يمثل acExport (قيمة ثابتة لعملية التصدير) ' 8 يمثل acSpreadsheetTypeExcel97 (قيمة ثابتة لنوع ملف الإكسل Excel 97-2003) DoCmd.TransferSpreadsheet 0, 8, "tbl_Teacher", varFilePath, False ' عرض رسالة نجاح للمستخدم تتضمن المسار الذي تم الحفظ فيه MsgBox ("تم استخراج ملف أكسل لبيانات الموظفيـن وحفظه في: " & Chr(13) & Chr(13) & varFilePath), vbOKOnly + vbMsgBoxRight, "تنبيه" Else ' إذا ألغى المستخدم عملية الحفظ (ضغط على Cancel) MsgBox "تم إلغاء عملية حفظ ملف الإكسل.", vbInformation + vbMsgBoxRight, "تنبيه" End If End With ' تحرير كائن مربع حوار الملفات لتحرير الذاكرة Set objFileDialog = Nothing Else ' عرض رسالة إذا لم تكن هناك سجلات في الجدول لتصديرها MsgBox ("لا يوجد سجلات لتصديرها "), vbOKOnly + vbMsgBoxRight, "تنبيه" End If Exit_cm_ToExcel_Click: ' نقطة الخروج العادية من الإجراء Exit Sub Err_cm_ToExcel_Click: ' معالج الأخطاء: عرض وصف الخطأ الذي حدث MsgBox Err.Description, vbCritical, "خطأ" ' استئناف التنفيذ عند نقطة الخروج العادية من الإجراء Resume Exit_cm_ToExcel_Click End Sub

أنظر هنا أيضا 🙂 :

وعليكم السلام ورحمة الله 🙂 باستخدام هذه الأداة : Private Sub cmdPrint_Click() On Error GoTo Err_cmdPrint_Click Dim Index3 As Variant Dim repName As String Dim ftrName As String ' Declare ftrName, assuming it's a String for the filter argument. ' Check if any items are selected from the listbox. If L3.ItemsSelected.Count = 0 Then MsgBox "لا يوجد مطبوغات قد تم اختيارها", vbInformation + vbMsgBoxRight, "تنبيه " Exit Sub End If ' Loop through each selected item and open the corresponding report. For Each Index3 In L3.ItemsSelected repName = L3.ItemData(Index3) repName = "تقرير_" & repName DoCmd.OpenReport repName, acViewNormal, , ftrName Next Index3 Exit_cmdPrint_Click: Exit Sub Err_cmdPrint_Click: MsgBox Err.Description Resume Exit_cmdPrint_Click End Sub مع اختيار : والتعليمات نفس رسالتك مع تغيير بسيط : الكود التالى يعمل بدون مشاكل ولكن هناك سطور مكررة متداخلة به يرجى ضبط بناء الكود لاختصاره وتحسينه

غفر الله ذنوبك كلها وعفا عنك وأحسن إليك ورزقك من حيث لا تحتسب .. لك ولوالديك وجميع أحبابك 😊🤲 وعدت فأوفيت .. وصنعت تحفة راااااائعة قمة في الجمال .

الله الله الله .. عمل فوق الوصف وأداة قمة في الروعة ما شاء الله عليك 😃 والفائدة أصبحت فائدتان عندما شرحت طريقة إضافتها كـ Add-In للبرنامج ( معلومة كنت أبحث عنها من زمااااااان ) 😅👌 جزاك الله خيرا كثيرا .. وغفر الله لك ولوالديك وجزاكم جنات ونهر في مقعد صدق عند مليك مقتدر 😊🤲 هل هذا أحد الخيارات ؟ لربما أنه يعتمد على لغة النظام .. فعندي تظهر الأزرار باللغة العربية

شكرا لك أخي منتصر على هذه الإبداعات .. 🙂 أنت تجعل الحياة أجمل .. والعمل أسهل 🌼 أقترح عليك تصميم أداة جديدة لتصميم الرسائل الاعتيادية أيضا ( MSGBOX ) وللتغذية البصرية هذه أداة تم تصميمها في إضافة (غير مجانية) للأكسس تقوم بعمل هذه المهمة : ويوجد مثلها لصندوق الإدخال InputBox : ولك الأجر والمثوبة 😇🌹

هدية كريمة .. من أخ كريم .. في شهر كريم 🙂 🌹 كتب الله لك أجرها .. ونفع بها .. ما حدث معي .. كلما أنقلها إلى أي قاعدة بيانات تقابلني هذه الرسالة بشكل مزعج ومتكرر عند فتح النموذج وعند تشغيل أي إجراء .. !

يقول المثل : ما لا يُدرك جُلُه .. لا يُترَك كُلُه 😄🖐️ وبعدين 95% نسبة حلوة تخش بيها كلية الهندسة إن شاء الله 😅

توضيح : الكود أشتغل هنا بشكل ممتاز بنسبة 95% 👍 .. الصورة توضح ( قبل وبعد ) تطبيق الكود أو تشغيل الوظيفة. لكن في الصورة الأخرى ضلت المشكلة قائمة، ولعله يكون هناك تعديل يمكن إجراؤه لمراعاة إجراءات الحدث OnTimer .

وعليكم السلام ورحمة الله وبركاته ،،، ماشاء الله تبارك الله .. طرح مميز جدا وغير مسبوق جربت على نموذجين أحدهما كان نموذج قديم ولم نعرف حل لمشكلة الترميش حينها ولكن كودك نجح بامتياز : والآخر هو نفس نموذجك مع بعض الإضافات ولكن لا تزال المشكلة قائمة .. 🤷‍♂️ Anti Flicker.accdb

2️⃣

تعمل عندي بشكل جيد 👍🙂

قصدك : عدم إستعمال المسميات العربية للحقول أو العناصر أو المكونات ......... عدم استعمال المسافات بين أسماء المكونات .......... 😄☝️ حتى لا يفهم قصدك معكوسا 😎

بعد تجربة الجزء الأول من المشروع ، تم الإرسال بنجاح ولله الحمد 👍🙂 وننتظر الجزء الثاني بشوق 😊👌

وهذي مشاركتي المتواضعة 🙂 التحدي 1 - التعامل مع الجداول وخصائصها - موسى.accdb

هذا الموضوع أثار في نفسي فكرة لا أدري هل ستنجح بهذه الميكانيكية أم لا .. 🙂 وربما تكون بذرة لفكرة أكبر .. ألا وهي : الوضع الليلي والوضع النهاري للبرنامج - Dark mode & light mode

شكرا لك أخي الحبيب @ابو جودي ومنكم نستفيد 🙂🌹

إذا أداتنا الجبارة ما أستطاعت تعملها .. فممكن تقترح لنا حلول أو أفكار لتطويرها علشان تقدر تركز عليها وهي تشتغل ؟ 🙂