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

السلام عليكم ورحمة الله وبركاته 🙂🖐 يقول المثل : أن تأتي متأخرا خير من أن لا تأتي 😅✌ بعد جهد جهيد إنتهيت من تصميم نظام تسجيل دخول + نظام صلاحيات متطور كلما أخطو فيه خطوة أجد أنه ناقص وتطلع أفكار جديدة .. 😅👊 لذلك قلت سأنزلها كما هي الآن .. حاولت تبسيطه للمستخدم والمستفيدين منه لاحقا قدر المستطاع .. وسأبدأ بواجهة تسجيل الدخول المتواضعة : المزايا : حفظ بيانات دخول المستخدم (اختياري) الدخول مباشرة بمجرد كتابة كلمة المرور بشكل صحيح (تسريع عملية الدخول) ملاحظة : جميع كلمات المرور في البرنامج : 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 :: وآخر دعوانا أن الحمد لله رب العالمين ::

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

جرب الملف و تأكد أن تعمل توسيط للأرقام في الخلية الدوائر تعمل تلقائيا بمجرد ادخال الرقم و تختفي تلقائيا لو تم التعديل بداية من 50 دائرة حول الرقم.xlsm

دي آخر مرحلة في الوقت الحالي

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

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

اليك كودك بعد التصحيح: بدلا عن Function DialogColor(rgb As Long) As Long Call ChooseColor(Application.hWndAccessApp, rgb) DialogColor = rgb End Function استعمل #If VBA7 Then Function DialogColor(rgb As LongPtr) As LongPtr #Else Function DialogColor(rgb As Long) As Long #End If Call ChooseColor(Application.hWndAccessApp, rgb) DialogColor = rgb End Function . والسبب: عند استعمال 64بت ، المتغير rgb (لاحظ انه المتغير رقم 2 في الدالة ChooseColor) والدالة ChooseColor يصبحون LongPtr ، وعليه ، وفي الدالة DialogColor ، فاننا ننادي الدالة ChooseColor ، والمتغير رقم 2 هو rgb ، فيجب ان يكون نفس نوع rgb الـ 64بت ، وهو LongPtr ، وعند اعطائنا قيمة rgb الى DialogColor (في المعادلة DialogColor=rgb) ، فيجب ان DialongColor تصبح LongPtr ايضا. لذلك في حالة 64 بت ، يجب استعمال Function DialogColor(rgb As LongPtr) As LongPtr 1643.FileDialog.accdb

بالفعل لم تعمل معي

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

حاولت فعلاً أن أستنبط فكرتكم بكل صدق لأثري معلومتي . وكانت تجربتي أن الفكرة على الإصدار 64 لا تعمل للأسف ، ولكنها تعمل على الإصدار 32 فعلاً .. وهذا توضيح لمقصدي .

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

كودك صحيح من ناحية التركيب والمنطق، لكن هناك ملاحظات مهمة: 1. الاستخدام العملي هذا الكود يستدعي دالة داخلية غير موثقة (#53) في msaccess.exe لعرض صندوق حوار اختيار الألوان. هل ستنجح؟ على الأرجح لا، لأن الدالة الداخلية #53 قد تكون غير موجودة أو لا تقوم بما تظن. الطريقة الصحيحة والمستقرة هي استخدام Comdlg32.dll (ChooseColor API). 2. النظام الصحيح باستخدام API ويندوز بدلاً من ذلك، استخدم هذا الكود الموثوق: ' في بداية الموديول #If VBA7 Then Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long #Else Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long #End If Private Type CHOOSECOLOR lStructSize As Long hwndOwner As LongPtr hInstance As LongPtr rgbResult As Long lpCustColors As LongPtr Flags As Long lCustData As LongPtr lpfnHook As LongPtr lpTemplateName As String End Type Function DialogColor(Optional ByVal InitialColor As Long = &H0) As Long Dim cc As CHOOSECOLOR Dim CustColors(0 To 15) As Long cc.lStructSize = Len(cc) cc.hwndOwner = Application.hWndAccessApp cc.rgbResult = InitialColor cc.lpCustColors = VarPtr(CustColors(0)) cc.Flags = &H2 ' CC_RGBINIT If ChooseColor(cc) <> 0 Then DialogColor = cc.rgbResult Else DialogColor = InitialColor ' إذا تم الإلغاء End If End Function تفضل مرفقك بعد التعديل .ووافني بالرد . Database1-1.accdb

دا اكيد 😋😛 انا بقول زياده الخير خيرين

ولسه فيها حاجات كتير كمان .. قلت نسمع أفكار الناس اللي بتمر من هنا ، ما سمعتش غير صدى صوتي 🤣 .. قلت وماله ؛ صوتي حلو 😎 أما موضوع مايكروسوفت ، فأنا مش موافق حتى لو عرضوا علي الشغل معاهم ,, تخيل 🤣 ...

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

السلام عليكم يمكنك رفع الملف كما هو ، ويمكنك رفع الملف بضغطه ببرامج winRar او winZip ، والافضل في الضغط هو صيغة 7z. ويمكنك انزال برنامجه المجاني من هنا : https://www.7-zip.org/ ويمكنك رفع الملف على اي من مواقع رفع الملفات على الانترنت ، و ارفاق الرابط في الموضوع ، ويمكنك رفع الملف في حسابك في Google Drive ومشاركة الرابط هنا.

أعمال مميزة ، ومشاركات جميلة ومفيدة من الأساتذة @Ahmedgamall و @Barna ..

اعرض الملف UiMsg Framework - نظام رسائل احترافي استبدال صندوق الرسائل فى الاكسس بنموذج رسائل احترافى بسطر واحد بس كل حاجة جاهزة مش محتاج تفكر في تصميم نموذج مش محتاج نموذج الرسائل يكون موجود اساسا مش محتاج تكتب كود كبير بعد كده لصندوق الرسائل استدعي الدالة وخلاص والنظام يعمل كل شئ النظام يقدم 4 أنواع رسائل جاهزة : { معلومة - نجاح - تحذير - خطأ } كل نوع بتصميمه ولونه وأيقونته معلومة : من خلال : UiInfo اللون : أزرق نجاح : من خلال : UiSuccess اللون : أخضر تحذير : من خلال : UiWarning اللون : برتقالي خطأ : من خلال : UiError اللون : أحمر 3 أنواع إدخال : { نص حر - رقم مع تحقق تلقائي - اختيار من قائمة } نص حر : من خلال : UiInput رقم مع تحقق تلقائي: من خلال : UiInputNum يرفض الحروف بدون ما تكتب سطر واحد اختيار من قائمة : من خلال : UiPick قرارات متعددة : { تأكيد نعم/لا - ثلاثة خيارات أزرار مخصصة بأسماء ترجعها النتيجة مباشرة } نعم / لا : من خلال : BlnUiConfirm يرجع True أو False مباشرة ثلاثة خيارات : من خلال :IntUiConfirm3 يرجع 1 أو 2 أو 0 أزرار مخصصة : من خلال :UiCustom يرجع اسم الزر اللي اتضغط مش رقمه دعم كامل للعربية والإنجليزية : { اتجاه النص RTL/LTR تلقائي - الأزرار والعناوين بالغتين من خلال معامل UiLangEn يكفي لتبديل كل شيء } أضف UiLangEn كآخر parameter وكل شيء يتبدل : اتجاه النص - الأزرار - العناوين الافتراضية ثيم موحد قابل للتخصيص : { ألوان الهيدر والأيقونات والأزرار كلها من UiTheme غير لون الـ Accent في مكان واحد وكل الرسائل تتغير } كل ألوان النظام مجمعة في UiTheme مناسب لأي مشروع قاعدة بيانات صغير أو كبير - عربي أو إنجليزي - مبتدئ أو محترف يبني نفسه : لا تثبيت ولا إعداد كل إجراء أو وظيفة واضحة الاسم - واضحة الـ return - واضحة الاستخدام اسم الوحدة النمطية : modUIMsgFramework كود الوحدة النمطية.. Option Explicit Option Compare Database Public Enum UiIcon UiIconInfo = 0 UiIconSuccess = 1 UiIconWarning = 2 UiIconError = 3 UiIconQuestion = 4 End Enum Public Enum UiMode UiModeAlert = 0 UiModeInput = 1 UiModeNumber = 2 UiModeList = 3 End Enum Public Enum UiLang UiLangAr = 0 UiLangEn = 1 End Enum Public Type UiParams strMessage As String strTitle As String strButtons As String strDefault As String strList As String strDetails As String strResult As String enuIcon As UiIcon enuMode As UiMode enuLang As UiLang End Type Public Type UiTheme lngAccent As Long lngHeader As Long lngBg As Long lngText As Long lngMuted As Long lngBorder As Long lngSuccess As Long lngWarning As Long lngError As Long lngInfo As Long lngQuestion As Long End Type Private Const STRFORMNAME As String = "frmUiMsg" Private Const STRMODNAME As String = "modUICore" Private Const MAX_BUTTONS As Integer = 5 Private Const FRM_W As Long = 9000 Private m_typParams As UiParams Public Function TypDefaultTheme() As UiTheme Dim typT As UiTheme typT.lngAccent = RGB(0, 120, 212) typT.lngHeader = RGB(32, 32, 38) typT.lngBg = RGB(245, 246, 250) typT.lngText = RGB(30, 30, 35) typT.lngMuted = RGB(120, 120, 130) typT.lngBorder = RGB(210, 212, 220) typT.lngSuccess = RGB(16, 124, 16) typT.lngWarning = RGB(200, 100, 0) typT.lngError = RGB(196, 43, 28) typT.lngInfo = RGB(0, 120, 212) typT.lngQuestion = RGB(104, 33, 122) TypDefaultTheme = typT End Function Private Function BlnFormExists(ByVal strName As String) As Boolean On Error Resume Next Dim objFrm As Object Set objFrm = CurrentProject.AllForms(strName) BlnFormExists = Not (objFrm Is Nothing) Set objFrm = Nothing On Error GoTo 0 End Function Private Sub LogError(ByVal strProc As String, _ ByVal lngNum As Long, _ ByVal strDesc As String) Debug.Print "[" & STRMODNAME & "." & strProc & "] " & _ "Err " & lngNum & ": " & strDesc & _ " @ " & Now() End Sub Public Function TypGetParams() As UiParams TypGetParams = m_typParams End Function Public Sub SetResult(ByVal strResult As String) m_typParams.strResult = strResult End Sub Private Sub ResetParams() Dim typEmpty As UiParams m_typParams = typEmpty End Sub Private Function StrDefaultTitle(ByVal enuIcon As UiIcon, _ ByVal enuLang As UiLang) As String If enuLang = UiLangAr Then Select Case enuIcon Case UiIconSuccess: StrDefaultTitle = "تم بنجاح" Case UiIconWarning: StrDefaultTitle = "تحذير" Case UiIconError: StrDefaultTitle = "خطأ" Case UiIconQuestion: StrDefaultTitle = "تأكيد" Case Else: StrDefaultTitle = "معلومة" End Select Else Select Case enuIcon Case UiIconSuccess: StrDefaultTitle = "Success" Case UiIconWarning: StrDefaultTitle = "Warning" Case UiIconError: StrDefaultTitle = "Error" Case UiIconQuestion: StrDefaultTitle = "Confirm" Case Else: StrDefaultTitle = "Information" End Select End If End Function Private Function StrValidateButtons(ByVal strBtns As String) As String Dim arrB() As String Dim intCnt As Integer Dim intI As Integer Dim strOut As String arrB = Split(strBtns, ",") intCnt = UBound(arrB) + 1 If intCnt > MAX_BUTTONS Then LogError "StrValidateButtons", 0, _ "تجاوز الحد الأقصى للأزرار (" & intCnt & "). سيتم اقتصارها على " & MAX_BUTTONS intCnt = MAX_BUTTONS End If For intI = 0 To intCnt - 1 If Len(strOut) > 0 Then strOut = strOut & "," strOut = strOut & Trim(arrB(intI)) Next intI StrValidateButtons = strOut End Function Private Function BlnBuildMsgForm() As Boolean On Error GoTo ErrHandler Dim typT As UiTheme Dim objFrm As Object Dim objCtl As Object Dim strTemp As String Dim intI As Integer Dim lngLeft As Long typT = TypDefaultTheme() Const HDR_H As Long = 900 Const ICON_L As Long = 200 Const ICON_T As Long = 150 Const ICON_W As Long = 600 Const ICON_H As Long = 600 Const TITLE_L As Long = 900 Const TITLE_T As Long = 200 Const TITLE_W As Long = 7800 Const TITLE_H As Long = 500 Const MSG_L As Long = 300 Const MSG_T As Long = 1050 Const MSG_W As Long = 8400 Const MSG_H As Long = 1400 Const DET_L As Long = 300 Const DET_T As Long = 2500 Const DET_W As Long = 8400 Const DET_H As Long = 700 Const INP_L As Long = 300 Const INP_T As Long = 3300 Const INP_W As Long = 8400 Const INP_H As Long = 450 Const DIV_T As Long = 4050 Const BTN_T As Long = 4250 Const BTN_W As Long = 1550 Const BTN_H As Long = 550 Const FRM_H As Long = 5000 Set objFrm = CreateForm strTemp = objFrm.Name With objFrm .Caption = "" .ScrollBars = 0 .RecordSelectors = False .NavigationButtons = False .DividingLines = False .BorderStyle = 1 .AutoCenter = True .PopUp = True .Modal = True .Width = FRM_W .Section(0).Height = FRM_H .Section(0).BackColor = typT.lngBg End With Set objCtl = CreateControl(strTemp, acRectangle, acDetail) With objCtl .Name = "recHeader": .Left = 0: .Top = 0 .Width = FRM_W: .Height = HDR_H .BackColor = typT.lngHeader: .BackStyle = 1 .BorderStyle = 0: .SpecialEffect = 0 End With Set objCtl = CreateControl(strTemp, acRectangle, acDetail) With objCtl .Name = "recIcon": .Left = ICON_L: .Top = ICON_T .Width = ICON_W: .Height = ICON_H .BackColor = typT.lngInfo: .BackStyle = 1 .BorderStyle = 0: .SpecialEffect = 0 End With Set objCtl = CreateControl(strTemp, acLabel, acDetail) With objCtl .Name = "lblIcon": .Caption = "i" .Left = ICON_L: .Top = ICON_T .Width = ICON_W: .Height = ICON_H .FontSize = 20: .FontBold = True .ForeColor = vbWhite: .BackStyle = 0: .TextAlign = 2 End With Set objCtl = CreateControl(strTemp, acLabel, acDetail) With objCtl .Name = "lblTitle": .Caption = "" .Left = TITLE_L: .Top = TITLE_T .Width = TITLE_W: .Height = TITLE_H .FontSize = 14: .FontBold = True .ForeColor = vbWhite: .BackStyle = 0: .TextAlign = 1 End With Set objCtl = CreateControl(strTemp, acLabel, acDetail) With objCtl .Name = "lblMessage": .Caption = "" .Left = MSG_L: .Top = MSG_T .Width = MSG_W: .Height = MSG_H .FontSize = 11: .ForeColor = typT.lngText .BackStyle = 0: .TextAlign = 1 End With Set objCtl = CreateControl(strTemp, acLabel, acDetail) With objCtl .Name = "lblDetails": .Caption = "" .Left = DET_L: .Top = DET_T .Width = DET_W: .Height = DET_H .FontSize = 9: .ForeColor = typT.lngMuted .BackStyle = 0: .Visible = False End With Set objCtl = CreateControl(strTemp, acTextBox, acDetail) With objCtl .Name = "txtInput" .Left = INP_L: .Top = INP_T .Width = INP_W: .Height = INP_H .FontSize = 11 .BorderColor = typT.lngBorder: .BackColor = vbWhite .Visible = False End With Set objCtl = CreateControl(strTemp, acComboBox, acDetail) With objCtl .Name = "cboList" .Left = INP_L: .Top = INP_T .Width = INP_W: .Height = INP_H .FontSize = 11 .BorderColor = typT.lngBorder: .BackColor = vbWhite .RowSourceType = "Value List" .LimitToList = True: .AllowValueListEdits = False .Visible = False End With Set objCtl = CreateControl(strTemp, acLine, acDetail) With objCtl .Name = "linDivider": .Left = 0: .Top = DIV_T .Width = FRM_W: .Height = 0 .BorderColor = typT.lngBorder: .BorderWidth = 1 End With For intI = 1 To MAX_BUTTONS lngLeft = 200 + ((intI - 1) * 1760) Set objCtl = CreateControl(strTemp, acCommandButton, acDetail) With objCtl .Name = "btn" & intI: .Caption = "btn" & intI .Left = lngLeft: .Top = BTN_T .Width = BTN_W: .Height = BTN_H .FontSize = 10: .FontBold = True .BackColor = typT.lngAccent: .ForeColor = vbWhite .BorderStyle = 0: .Visible = False .OnClick = "=ProcBtnClick(" & intI & ")" End With Next intI DoCmd.Save acForm, strTemp DoCmd.Close acForm, strTemp, acSaveYes DoCmd.Rename STRFORMNAME, acForm, strTemp BlnBuildMsgForm = True Set objCtl = Nothing: Set objFrm = Nothing Exit Function ErrHandler: LogError "BlnBuildMsgForm", Err.Number, Err.Description BlnBuildMsgForm = False Set objCtl = Nothing: Set objFrm = Nothing End Function Private Function BlnInjectMsgCode() As Boolean On Error GoTo ErrHandler Dim objMdl As Object Dim strCode As String Dim strOldCode As String DoCmd.OpenForm STRFORMNAME, acDesign, , , , acHidden Set objMdl = Forms(STRFORMNAME).Module If objMdl.CountOfLines > 0 Then strOldCode = objMdl.Lines(1, objMdl.CountOfLines) objMdl.DeleteLines 1, objMdl.CountOfLines End If strCode = StrFormCodeHeader() & _ StrFormCodeApplyIcon() & _ StrFormCodeApplyLang() & _ StrFormCodeSetupBtns() & _ StrFormCodeFillList() & _ StrFormCodeOpen() & _ StrFormCodeBtn() & _ StrFormCodeUnload() objMdl.AddFromString strCode If objMdl.CountOfLines < 10 Then If Len(strOldCode) > 0 Then objMdl.DeleteLines 1, objMdl.CountOfLines objMdl.AddFromString strOldCode End If LogError "BlnInjectMsgCode", 0, "AddFromString أنتج كوداً فارغاً، تم استعادة الكود القديم" BlnInjectMsgCode = False GoTo Cleanup End If DoCmd.Save acForm, STRFORMNAME DoCmd.Close acForm, STRFORMNAME, acSaveYes BlnInjectMsgCode = True Cleanup: Set objMdl = Nothing Exit Function ErrHandler: LogError "BlnInjectMsgCode", Err.Number, Err.Description BlnInjectMsgCode = False Set objMdl = Nothing End Function Private Function StrFormCodeHeader() As String Dim s As String s = "Option Explicit" & vbCrLf s = s & "Option Compare Database" & vbCrLf & vbCrLf s = s & "Private mintMode As Integer" & vbCrLf s = s & "Private mintLang As Integer" & vbCrLf & vbCrLf StrFormCodeHeader = s End Function Private Function StrFormCodeApplyIcon() As String Dim s As String s = "Private Sub ProcApplyIcon(ByVal intIcon As Integer)" & vbCrLf s = s & " Select Case intIcon" & vbCrLf s = s & " Case 1" & vbCrLf s = s & " Me.recHeader.BackColor = RGB(16,124,16)" & vbCrLf s = s & " Me.recIcon.BackColor = RGB(16,124,16)" & vbCrLf s = s & " Me.lblIcon.Caption = Chr(252)" & vbCrLf s = s & " Me.lblIcon.FontName = ""Wingdings""" & vbCrLf s = s & " Case 2" & vbCrLf s = s & " Me.recHeader.BackColor = RGB(200,100,0)" & vbCrLf s = s & " Me.recIcon.BackColor = RGB(200,100,0)" & vbCrLf s = s & " Me.lblIcon.Caption = Chr(56)" & vbCrLf s = s & " Me.lblIcon.FontName = ""Wingdings""" & vbCrLf s = s & " Case 3" & vbCrLf s = s & " Me.recHeader.BackColor = RGB(196,43,28)" & vbCrLf s = s & " Me.recIcon.BackColor = RGB(196,43,28)" & vbCrLf s = s & " Me.lblIcon.Caption = Chr(251)" & vbCrLf s = s & " Me.lblIcon.FontName = ""Wingdings""" & vbCrLf s = s & " Case 4" & vbCrLf s = s & " Me.recHeader.BackColor = RGB(104,33,122)" & vbCrLf s = s & " Me.recIcon.BackColor = RGB(104,33,122)" & vbCrLf s = s & " Me.lblIcon.Caption = Chr(63)" & vbCrLf s = s & " Me.lblIcon.FontName = ""Wingdings""" & vbCrLf s = s & " Case Else" & vbCrLf s = s & " Me.recHeader.BackColor = RGB(0,120,212)" & vbCrLf s = s & " Me.recIcon.BackColor = RGB(0,120,212)" & vbCrLf s = s & " Me.lblIcon.Caption = Chr(105)" & vbCrLf s = s & " Me.lblIcon.FontName = ""Arial""" & vbCrLf s = s & " End Select" & vbCrLf s = s & "End Sub" & vbCrLf & vbCrLf StrFormCodeApplyIcon = s End Function Private Function StrFormCodeApplyLang() As String Dim s As String s = "Private Sub ProcApplyLang(ByVal intLang As Integer)" & vbCrLf s = s & " Dim intAlign As Integer" & vbCrLf s = s & " intAlign = IIf(intLang = 0, 3, 1)" & vbCrLf s = s & " Me.lblTitle.TextAlign = intAlign" & vbCrLf s = s & " Me.lblMessage.TextAlign = intAlign" & vbCrLf s = s & " Me.lblDetails.TextAlign = intAlign" & vbCrLf s = s & " Me.txtInput.TextAlign = intAlign" & vbCrLf s = s & " Me.cboList.TextAlign = intAlign" & vbCrLf s = s & "End Sub" & vbCrLf & vbCrLf StrFormCodeApplyLang = s End Function Private Function StrFormCodeSetupBtns() As String Dim s As String s = "Private Sub ProcSetupBtns(ByVal strBtns As String, ByVal intLang As Integer)" & vbCrLf s = s & " Dim arrBtns() As String" & vbCrLf s = s & " Dim intTotal As Integer" & vbCrLf s = s & " Dim intI As Integer" & vbCrLf s = s & " Dim lngBtnW As Long" & vbCrLf s = s & " Dim lngBtnH As Long" & vbCrLf s = s & " Dim lngGap As Long" & vbCrLf s = s & " Dim lngTotalW As Long" & vbCrLf s = s & " Dim lngStartX As Long" & vbCrLf s = s & " Dim blnIsRtl As Boolean" & vbCrLf s = s & " arrBtns = Split(strBtns, "","")" & vbCrLf s = s & " intTotal = UBound(arrBtns) + 1" & vbCrLf s = s & " If intTotal > 5 Then intTotal = 5" & vbCrLf s = s & " blnIsRtl = (intLang = 0)" & vbCrLf s = s & " lngBtnW = 1550" & vbCrLf s = s & " lngBtnH = 550" & vbCrLf s = s & " lngGap = 200" & vbCrLf s = s & " lngTotalW = (intTotal * lngBtnW) + ((intTotal - 1) * lngGap)" & vbCrLf s = s & " lngStartX = (Me.Width - lngTotalW) \ 2" & vbCrLf s = s & " For intI = 1 To 5" & vbCrLf s = s & " Me(""btn"" & intI).Visible = False" & vbCrLf s = s & " Next intI" & vbCrLf s = s & " For intI = 1 To intTotal" & vbCrLf s = s & " With Me(""btn"" & intI)" & vbCrLf s = s & " .Caption = Trim(arrBtns(intI - 1))" & vbCrLf s = s & " If blnIsRtl Then" & vbCrLf s = s & " .Left = lngStartX + ((intTotal - intI) * (lngBtnW + lngGap))" & vbCrLf s = s & " Else" & vbCrLf s = s & " .Left = lngStartX + ((intI - 1) * (lngBtnW + lngGap))" & vbCrLf s = s & " End If" & vbCrLf s = s & " .Top = 4250: .Width = lngBtnW: .Height = lngBtnH" & vbCrLf s = s & " .Visible = True" & vbCrLf s = s & " End With" & vbCrLf s = s & " Next intI" & vbCrLf s = s & "End Sub" & vbCrLf & vbCrLf StrFormCodeSetupBtns = s End Function Private Function StrFormCodeFillList() As String Dim s As String s = "Private Sub ProcFillList(ByVal strItems As String, ByVal strDefault As String)" & vbCrLf s = s & " Dim arrItems() As String" & vbCrLf s = s & " Dim strSource As String" & vbCrLf s = s & " Dim intI As Integer" & vbCrLf s = s & " arrItems = Split(strItems, "","")" & vbCrLf s = s & " For intI = 0 To UBound(arrItems)" & vbCrLf s = s & " strSource = strSource & Trim(arrItems(intI)) & "";""" & vbCrLf s = s & " Next intI" & vbCrLf s = s & " Me.cboList.RowSource = strSource" & vbCrLf s = s & " If Len(Trim(strDefault)) > 0 Then" & vbCrLf s = s & " Me.cboList.Value = strDefault" & vbCrLf s = s & " ElseIf UBound(arrItems) >= 0 Then" & vbCrLf s = s & " Me.cboList.Value = Trim(arrItems(0))" & vbCrLf s = s & " End If" & vbCrLf s = s & "End Sub" & vbCrLf & vbCrLf StrFormCodeFillList = s End Function Private Function StrFormCodeOpen() As String Dim s As String s = "Private Sub Form_Open(Cancel As Integer)" & vbCrLf s = s & " On Error GoTo ErrHandler" & vbCrLf s = s & " Dim typP As UiParams" & vbCrLf s = s & " typP = TypGetParams()" & vbCrLf s = s & " mintMode = CInt(typP.enuMode)" & vbCrLf s = s & " mintLang = CInt(typP.enuLang)" & vbCrLf s = s & " Me.Caption = typP.strTitle" & vbCrLf s = s & " Me.lblTitle.Caption = typP.strTitle" & vbCrLf s = s & " Me.lblMessage.Caption = typP.strMessage" & vbCrLf s = s & " Me.lblDetails.Visible = (Len(Trim(typP.strDetails)) > 0)" & vbCrLf s = s & " If Me.lblDetails.Visible Then Me.lblDetails.Caption = typP.strDetails" & vbCrLf s = s & " ProcApplyIcon CInt(typP.enuIcon)" & vbCrLf s = s & " ProcApplyLang mintLang" & vbCrLf s = s & " ProcSetupBtns typP.strButtons, mintLang" & vbCrLf s = s & " Me.txtInput.Visible = (mintMode = 1 Or mintMode = 2)" & vbCrLf s = s & " Me.cboList.Visible = (mintMode = 3)" & vbCrLf s = s & " If mintMode = 1 Or mintMode = 2 Then" & vbCrLf s = s & " Me.txtInput.Value = typP.strDefault" & vbCrLf s = s & " Me.txtInput.SetFocus" & vbCrLf s = s & " End If" & vbCrLf s = s & " If mintMode = 3 Then" & vbCrLf s = s & " ProcFillList typP.strList, typP.strDefault" & vbCrLf s = s & " Me.cboList.SetFocus" & vbCrLf s = s & " End If" & vbCrLf s = s & " Exit Sub" & vbCrLf s = s & "ErrHandler:" & vbCrLf s = s & " Debug.Print ""Form_Open Err: "" & Err.Number & "" - "" & Err.Description" & vbCrLf s = s & " DoCmd.Close acForm, Me.Name" & vbCrLf s = s & "End Sub" & vbCrLf & vbCrLf StrFormCodeOpen = s End Function Private Function StrFormCodeBtn() As String Dim s As String s = "Public Function ProcBtnClick(ByVal intNum As Integer)" & vbCrLf s = s & " On Error GoTo ErrHandler" & vbCrLf s = s & " Dim strResult As String" & vbCrLf s = s & " Dim strWarn As String" & vbCrLf s = s & " Select Case mintMode" & vbCrLf s = s & " Case 1" & vbCrLf s = s & " If intNum = 1 Then" & vbCrLf s = s & " strResult = Nz(Me.txtInput.Value, """")" & vbCrLf s = s & " Else" & vbCrLf s = s & " strResult = ""__CANCEL__""" & vbCrLf s = s & " End If" & vbCrLf s = s & " Case 2" & vbCrLf s = s & " If intNum = 1 Then" & vbCrLf s = s & " If Len(Nz(Me.txtInput.Value, """")) > 0 Then" & vbCrLf s = s & " If Not IsNumeric(Me.txtInput.Value) Then" & vbCrLf s = s & " strWarn = IIf(mintLang = 0, ""أدخل رقماً صحيحاً"", ""Enter a valid number"")" & vbCrLf s = s & " MsgBox strWarn, vbExclamation" & vbCrLf s = s & " Me.txtInput.SetFocus" & vbCrLf s = s & " Exit Function" & vbCrLf s = s & " End If" & vbCrLf s = s & " End If" & vbCrLf s = s & " strResult = Nz(Me.txtInput.Value, """")" & vbCrLf s = s & " Else" & vbCrLf s = s & " strResult = ""__CANCEL__""" & vbCrLf s = s & " End If" & vbCrLf s = s & " Case 3" & vbCrLf s = s & " If intNum = 1 Then" & vbCrLf s = s & " strResult = Nz(Me.cboList.Value, """")" & vbCrLf s = s & " Else" & vbCrLf s = s & " strResult = ""__CANCEL__""" & vbCrLf s = s & " End If" & vbCrLf s = s & " Case Else" & vbCrLf s = s & " strResult = Me(""btn"" & intNum).Caption" & vbCrLf s = s & " End Select" & vbCrLf s = s & " SetResult strResult" & vbCrLf s = s & " DoCmd.Close acForm, Me.Name" & vbCrLf s = s & " Exit Function" & vbCrLf s = s & "ErrHandler:" & vbCrLf s = s & " Debug.Print ""ProcBtnClick Err: "" & Err.Number & "" - "" & Err.Description" & vbCrLf s = s & "End Function" & vbCrLf & vbCrLf StrFormCodeBtn = s End Function Private Function StrFormCodeUnload() As String Dim s As String s = "Private Sub Form_Unload(Cancel As Integer)" & vbCrLf s = s & " Dim typP As UiParams" & vbCrLf s = s & " typP = TypGetParams()" & vbCrLf s = s & " If Len(Nz(typP.strResult, """")) = 0 Then" & vbCrLf s = s & " SetResult ""__CANCEL__""" & vbCrLf s = s & " End If" & vbCrLf s = s & "End Sub" & vbCrLf StrFormCodeUnload = s End Function Private Function BlnEnsureForm() As Boolean On Error GoTo ErrHandler If BlnFormExists(STRFORMNAME) Then BlnEnsureForm = True Exit Function End If If Not BlnBuildMsgForm() Then LogError "BlnEnsureForm", 0, "BlnBuildMsgForm failed" Exit Function End If If Not BlnInjectMsgCode() Then LogError "BlnEnsureForm", 0, "BlnInjectMsgCode failed" Exit Function End If BlnEnsureForm = True Exit Function ErrHandler: LogError "BlnEnsureForm", Err.Number, Err.Description BlnEnsureForm = False End Function Private Function StrShowMsg(ByVal strMsg As String, _ ByVal enuIcon As UiIcon, _ ByVal strBtns As String, _ ByVal strTitle As String, _ ByVal enuMode As UiMode, _ ByVal strDef As String, _ ByVal strList As String, _ ByVal strDet As String, _ ByVal enuLang As UiLang) As String On Error GoTo ErrHandler If Not BlnEnsureForm() Then LogError "StrShowMsg", 0, "EnsureForm failed" StrShowMsg = "__CANCEL__" Exit Function End If If Len(Trim(strTitle)) = 0 Then strTitle = StrDefaultTitle(enuIcon, enuLang) End If ResetParams With m_typParams .strMessage = strMsg .strTitle = strTitle .strButtons = StrValidateButtons(strBtns) .enuIcon = enuIcon .enuMode = enuMode .strDefault = strDef .strList = strList .strDetails = strDet .enuLang = enuLang .strResult = "" End With DoCmd.OpenForm STRFORMNAME, acNormal, , , , acDialog StrShowMsg = m_typParams.strResult If Len(StrShowMsg) = 0 Then StrShowMsg = "__CANCEL__" ResetParams Exit Function ErrHandler: LogError "StrShowMsg", Err.Number, Err.Description ResetParams StrShowMsg = "__CANCEL__" End Function Public Sub UiInfo(ByVal strMsg As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) Dim strBtns As String strBtns = IIf(enuLang = UiLangAr, "موافق", "OK") StrShowMsg strMsg, UiIconInfo, strBtns, strTitle, UiModeAlert, "", "", "", enuLang End Sub Public Sub UiSuccess(ByVal strMsg As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) Dim strBtns As String strBtns = IIf(enuLang = UiLangAr, "موافق", "OK") StrShowMsg strMsg, UiIconSuccess, strBtns, strTitle, UiModeAlert, "", "", "", enuLang End Sub Public Sub UiWarning(ByVal strMsg As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) Dim strBtns As String strBtns = IIf(enuLang = UiLangAr, "موافق", "OK") StrShowMsg strMsg, UiIconWarning, strBtns, strTitle, UiModeAlert, "", "", "", enuLang End Sub Public Sub UiError(ByVal strMsg As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal strDetails As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) Dim strBtns As String strBtns = IIf(enuLang = UiLangAr, "موافق", "OK") StrShowMsg strMsg, UiIconError, strBtns, strTitle, UiModeAlert, "", "", strDetails, enuLang End Sub Public Function BlnUiConfirm(ByVal strMsg As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) As Boolean Dim strBtns As String Dim strYes As String Dim strResult As String strBtns = IIf(enuLang = UiLangAr, "نعم,لا", "Yes,No") strYes = IIf(enuLang = UiLangAr, "نعم", "Yes") strResult = StrShowMsg(strMsg, UiIconQuestion, strBtns, strTitle, UiModeAlert, "", "", "", enuLang) BlnUiConfirm = (strResult = strYes) End Function Public Function IntUiConfirm3(ByVal strMsg As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) As Integer Dim strBtns As String Dim strYes As String Dim strNo As String Dim strResult As String strBtns = IIf(enuLang = UiLangAr, "نعم,لا,إلغاء", "Yes,No,Cancel") strYes = IIf(enuLang = UiLangAr, "نعم", "Yes") strNo = IIf(enuLang = UiLangAr, "لا", "No") strResult = StrShowMsg(strMsg, UiIconQuestion, strBtns, strTitle, UiModeAlert, "", "", "", enuLang) Select Case strResult Case strYes: IntUiConfirm3 = 1 Case strNo: IntUiConfirm3 = 2 Case Else: IntUiConfirm3 = 0 End Select End Function Public Function UiInput(ByVal strMsg As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal strDefault As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) As String Dim strBtns As String Dim strResult As String strBtns = IIf(enuLang = UiLangAr, "موافق,إلغاء", "OK,Cancel") strResult = StrShowMsg(strMsg, UiIconInfo, strBtns, strTitle, UiModeInput, strDefault, "", "", enuLang) UiInput = IIf(strResult = "__CANCEL__", "", strResult) End Function Public Function UiInputNum(ByVal strMsg As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal strDefault As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) As String Dim strBtns As String Dim strResult As String strBtns = IIf(enuLang = UiLangAr, "موافق,إلغاء", "OK,Cancel") strResult = StrShowMsg(strMsg, UiIconInfo, strBtns, strTitle, UiModeNumber, strDefault, "", "", enuLang) Select Case strResult Case "__CANCEL__", "": UiInputNum = "" Case Else UiInputNum = IIf(IsNumeric(strResult), strResult, "") End Select End Function Public Function UiPick(ByVal strMsg As String, _ ByVal strItems As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal strDefault As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) As String Dim strBtns As String Dim strResult As String strBtns = IIf(enuLang = UiLangAr, "موافق,إلغاء", "OK,Cancel") strResult = StrShowMsg(strMsg, UiIconQuestion, strBtns, strTitle, UiModeList, strDefault, strItems, "", enuLang) UiPick = IIf(strResult = "__CANCEL__", "", strResult) End Function Public Function UiCustom(ByVal strMsg As String, _ ByVal strBtns As String, _ Optional ByVal enuIcon As UiIcon = UiIconQuestion, _ Optional ByVal strTitle As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) As String Dim strResult As String strResult = StrShowMsg(strMsg, enuIcon, strBtns, strTitle, UiModeAlert, "", "", "", enuLang) UiCustom = IIf(strResult = "__CANCEL__", "", strResult) End Function ' ===================================== ' أمثلة الاستخدام ' ===================================== ' UiSuccess "تم انشاء النظام بنجاح" ' UiInfo "رسالة معلومة" ' UiWarning "تحذير: لا يمكن التراجع" ' UiError "حدث خطأ", "", "تفاصيل الخطأ" ' ' If BlnUiConfirm("هل تريد الحذف؟") Then ... ' ' Select Case IntUiConfirm3("حفظ التغييرات؟") ' Case 1: ' نعم ' Case 2: ' لا ' Case 0: ' إلغاء ' End Select ' ' Dim s As String ' s = StrUiInput("أدخل اسمك", "", "محمد") ' If Len(s) > 0 Then ... ' ' Dim n As String ' n = StrUiInputNum("أدخل العمر", "", "25") ' ' Dim pick As String ' pick = StrUiPick("اختر قسم", "مبيعات,محاسبة,مخازن,إدارة") ' ' Dim choice As String ' choice = StrUiCustom("اختر خيار", "حفظ,تجاهل,إلغاء") ' Select Case choice ' Case "حفظ": ... ' Case "تجاهل": ... ' Case "": ' أُغلق بدون اختيار ' End Select طريقة الاعداد و التشغيل : بعد اضافة الوحدة النمطية: modUIMsgFramework الى قاعدة بياناتك استدعي من أي زر أمر داخل أى نموذج أو من النافذة الفورية مباشرة UiSuccess "تم انشاء النظام بنجاح" للتجربة الفورية فى المرفق تم اضافة ما يلى : وحدة نمطية باسم : modBuildTestUI ماكرو باسم : BuildTestUI شغل الماكرو BuildTestUI على الفور هيتم عمل جدول tblEmployees يحتوى على بيانات افتراضية غير حقيقية للتجربة وهيتم عمل نموذج اختبار متكامل وفتحة بشكل مباشر صاحب الملف عسل قليل الدسم تمت الاضافه 04/29/26 الاقسام قسم الأكسيس  

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

تفضل <<<<<<<<<<<<<<< التعديل يكون في الجدول وليس النموذج مثال عملي.accdb

السلام عليكم هذة فكرة طرات في بالي منذ فترة ولكن لم اعمل على تطوريها او تجربتها المشكلة ان هناك اقسام للمستخدمين ولكن بعض المستخدمين لهم صلاحيات مخصصة والبعض لا ومن هنا جائت الفكرة الفكرة تعتمد على وجود جدول يحتوي على الازرار في صورة Btn ID (يتم حفظه داخل Btn Tag) و ID المستخدم مع امكانيات الاظهار و التمكين وعند فتح النموذج يقوم النموذج بمراجعة صلاحيات كل زر الهدف من استخدام Btn ID داخل الـ Tag هو اختصار الكثير من الازار داخل مجموعة من الـ Btns IDs (مجموعة من الازار لهم جميعا نفس الـ Btn ID) هي مجرد فكرة ولكن اتمنى راي حضراتكم

فى انتظار نهاية المدة بلهفة واشتياق علشان نشوف الافكار النيرة ......... علشان نتعلم ونثقل خبرتنا