hanan_ms

من قيمة فقط DlookUp اذاهاب الى سجل جديده جرب اضافة زر في النموذج الرئيسي خارج فرعي DOA اضافة سجل مع الفحص لتكوين Dim Ttb3 As Recordset Dim Key1,key2,key3 Set Ttb3 = CurrentDb.OpenRecordset("اسم_جدولك") Ttb3.AddNew Ttb3![اسم_الحقل] = Key1 'Ttb3![اسم _الحقل] = Key2 Ttb3![اسم _الحقل] = Key3 Ttb3.Update DoEvents الفرعي استخدم تحديد Forms.(اسم_النموذج).form(اسم_النموذج_الفرعي).Requery او استخدم Form_اسم_النموذج_الفرعي.Requery نفترض انشاء مفتاح تسلسل يوجد موضوع لاستاذي @ابو جودي ☕☕❤️🌹 في طريقة اضافة اداة Tools من ActiveX 😇

=====================( مرفق وفيديو وصور وبعض الشرح ) برنامج او اداة لبناء جمل SQL , DOA 1- اضافة توقيع للكود 2- اظهار كافة الحقول والمفتاح الاساسي 1-2 3- الاستعلامات اضاهار الحقو والمفتاح الاساسي وتحديد الجدولين بالاسم 1_2 4- اضافة دوال مجال بعد اذن استاذ @Moosak 🌹❤️☕ 5- اضافة مسارات النماذج والتقارير الى الفرعيات 6789... +++ ---------------------------------------------- 6- اضافة شروحات وتستطيع اضافة كود ثم عرضة بسهولة ------------------------------------------------ كان مرفق بأسم Personnel_affairs في احدى مواضيع بنيان الجداول خطأ بسبب تفرقة الخوادم لنك 2 بس طريقة ثانية فكنت بكمل سويت موضوع ثاني Index Tab To TabX ----------------------------------------------------------------------------------------------------------- احتاج دعمكم للاستكمال ليس من الشرط الدخول الى ركام الدوال ابني من المعطيات بناء جملة مثال على الاستخراج SQL ╔════════════════════╗ ║ ███╗ ███╗ ║ ║ ████╗ ████║ ║ ║ ██╔████╔██║s_hanan║ ║ ██║╚██╔╝██║ ║ ║ ██║ ╚═╝ ██║ ║ ╚═══╩═══════╩══╝ On Error GoTo Ops Dim strsql As String strsql = Delete * from DmnFunBldrT WHERE [FieldSize] = #2025/06/09# AND [ConditionType] = #2026/02/02# AND [Form_Index_ID_Table] = DCount("[Dile]","[Deil_Devloper]"," [ID] Is Not Null ") _ & SELECT * FROM [Query_Now] WHERE [FieldSize] = #2025/06/09# AND [ConditionType] = #2026/02/02# AND [Form_Index_ID_Table] = DCount("[Dile]","[Deil_Devloper]"," [ID] Is Not Null ");" CurrentDb.Execute strsql , dbFailOnError Me.Requery '-----------------------------------------------------------------------( For Error Code Only Copy And No Can use Function = Here Error :) X exit_Ops: Exit Sub Ops: MsgBox "حدث خطأ: & Err.Description, vbCritical Resume exit_Ops مثال DOA / \ \ / / \ \ \ _____________ _ |=============|/A\ | | U/ |_____________|_/ \ / \_________/ Dim DB As DAO.Database Dim RS As DAO.Recordset Dim FLD As DAO.Field Dim DBC As DAO.Database Dim RSC As DAO.Recordset Dim FLDC As DAO.Field On Error GoTo ErrorHandler Dim FPath As String FPath = If Dir(FPath) <> " Then Set db = DBEngine.OpenDatabase ( FPath,False, True,;PWD=234344 ) Dim FPath2 As String FPath2 = skjgksgjk kjskgaka If Dir(FPath2) <> " Then Set DBC = DBEngine.OpenDatabase ( FPath2,False, True,;PWD=Forms![Add_Filed=Control]![ST] ) ' فتح Recordset strSQL = "SELECT [FieldName], [FieldType] FROM [Tablet_Now] WHERE [FieldSize] = #2025/06/09# AND [ConditionType] = #2026/02/02# AND [Form_Index_ID_Table] = DCount("[Dile]","[Deil_Devloper]"," [ID] Is Not Null ")" INNER JOIN [Box_INFO_DOA_SQL] ON [DmnFunBldrT].[ID] = [Box_INFO_DOA_SQL].[ID] WHERE SELECT * FROM [Query_Now] WHERE [FieldSize] = #2025/06/09# AND [ConditionType] = #2026/02/02# AND [Form_Index_ID_Table] = DCount("[Dile]","[Deil_Devloper]"," [ID] Is Not Null ") ORDER BY رقم القرار") ' معالجة النتائج ' معالجة الحقل [And_Or] If Not IsNull(rs.Fields![And_Or]) Then rs.Fields![And_Or] = "--اكتب الكود هنا--" End If ' معالجة الحقل [CondCbo] If Not IsNull(rs.Fields![CondCbo]) Then rs.Fields![CondCbo] = "--اكتب الكود هنا--" End If ' معالجة الحقل [DomainTxt] If Not IsNull(rs.Fields![DomainTxt]) Then rs.Fields![DomainTxt] = "--اكتب الكود هنا--" End If ' معالجة الحقل [FieldCbo] If Not IsNull(rs.Fields![FieldCbo]) Then rs.Fields![FieldCbo] = "--اكتب الكود هنا--" End If ' معالجة الحقل [And_Or] من الجدول الثاني If Not IsNull(rs.Fields![And_Or]) Then rs.Fields![And_Or] = "--اكتب الكود هنا--" End If ' معالجة الحقل [DataTypeCbo] من الجدول الثاني If Not IsNull(rs.Fields![DataTypeCbo]) Then rs.Fields![DataTypeCbo] = "--اكتب الكود هنا--" End If ' معالجة الحقل [DomainTxt] من الجدول الثاني If Not IsNull(rs.Fields![DomainTxt]) Then rs.Fields![DomainTxt] = "--اكتب الكود هنا--" End If ' معالجة الحقل [End_Parentheses] من الجدول الثاني If Not IsNull(rs.Fields![End_Parentheses]) Then rs.Fields![End_Parentheses] = "--اكتب الكود هنا--" End If ' معالجة الحقل [FormCbo] من الجدول الثاني If Not IsNull(rs.Fields![FormCbo]) Then rs.Fields![FormCbo] = "--اكتب الكود هنا--" End If =' " & # Forms![Index_ID_Table]![Label25] # & " ' " =' " & Forms![INFO]![k2] & " ' " =' " & Me.k2 & " ' " rs.Filde!ConditionType = Forms![Add_Filed=Control]![ST] rs.Filde!ConditionType = Forms![Add_Where_SQL]![ST] rs.Filde!ConditionType = Forms![Index_ID_Table]![] rs.Filde!ConditionType = Forms![Index_ID_Table]![Label25] rs.Filde!ConditionType = Me.ST rs.Filde!FieldName = Forms![Index_ID_Table]![Label25] rs.Filde!FieldType = Me.Label25 rs.Filde!IsKey <> me.RT rs.Filde!mkan_scan = Forms![INFO]![k2] rs.Filde!mkan_scan = Me.k2 Rs.Close db.Close RSC.Close DBC.Close Set RS = Nothing Set DB = Nothing Set RSC = Nothing Set DBC = Nothing Else MsgBox قاعدة البيانات غير موجوده End IF Else MsgBox قاعدة البيانات غير موجوده End IF Exit Sub ErrorHandler: If Err.Number =3031 then MsgBox " كلمت المرور خاطأ تأكد من كلمت المرور للاتصال بقاعدة بيانات خارجية ") MsgBox "حدث خطأ: " & Err.Description, vbCritical Resume Next ' تنظيف الموارد If Not rs Is Nothing Then If rs.State = 1 Then rs.Close Set rs = Nothing End If Set db = Nothing اعتذر عدم اكماله ضغوطات وحاله صحيه تسمم غذائي ☕ وفي مميزات لم اشرحا استكمل البقية في فيديوا تحميل المرفق 1.8 MB https://www.mediafire.com/file/0fyiynev0lkldi2/Get_Code_SQL_DOA_2025.rar/file

=============================================( صور + مرفق + فيديو ) Update: 🌹 استاذي @ابو جودي ❤️🌹☕☕ التمسة طلبك ولتنفيذ بدون عوار راس ونظامي استاذ @Foksh ❤️🌹 وين رياك برمجة اقصد دوال متقدمة 1- ادارة قواعد بتعين كلمت مرور او الغاء كلمة المرور وحتى لم تكن لها كلمت مرور من الاصل الكل دفعة واحده بضغطة زر 2- ادارة النسخ الاحتياطية اخذ كل النسخ لكل نسخة داخل كل ملفات مع اختيار التصفية بالعدد المطلوب ويحذف القديم 3- قياس سعات التخزين بحديد للملفات مع سعة التخزين المتوفرة بالقرص الصلب او وحدة التخزين 4- انشاء حسابات وضافة بضغطة زر 5- اضافة تسمية النسخة اذا وشكة على الانتهاء تكتب بداية التاريخ الى نهاية التاريخ على سبيل المثال 2025 -2030 6- اضافة شريط متقدم للقياس عند ادارة القواعد والنسخ الاحتياطية تحميل المرفق https://www.mediafire.com/file/w5f2l1aajprsybg/Update_V1-8_Sys_DB_BackUP_One_Click_Ms_Access.rar/file

مشارك مع الاستاذ @Foksh❤️🌹☕ مشاركة للفرز المتتالي ولكن بطريقة مختلفة ويفضل فصل قاعدة بيانات ADODB.Recordest * بتمرير اسم الجدول ثم اسماء الحقول فقط @اشرف السيد يوسف عرض التقرير هل هو صحيح (( تصميم التقرير )) 1-الاسم تقرير فرعي 1- المحافظة التاريخ ملاحضة 2- الفرعي قابل النمو والتقلص والكل الصف مجموعة صح! او العكس المحافظة وفرعي اسمائهم مشكلتك ما حددة الوظيفه للفهم ADODB_Recordset_Rpt_Az_F1ToF0.rar

=============================================( صور + مرفق + فيديو ) Update: 🌹 هل توجد ملاحظات ؟ تحديث متقدم 1- تحسين المظهر Classes 2- تصحيح اضافة ايام العطل الرسمية 3- اضافة استخراج تاريخ dd\mm\YYYY او mm\dd\YYYYY 4-اضافة الوقت وتاريخ لكليهما الميــــلادي والهجــــــري او فقط تواريخ 5- اضافة التحكم بقائمة التخصيصي لتحديد ايام العطل في الاسبوح نقصد ايام الراحة لاي يوم او ايام الرياحة في الاسبوع + غفل الاسبوع $ 6- اضافة الوقت JRClock داخل التقويم JRCalender 7 - تصحيحات عامة للمخرجات نص من غير .Text MB 1,722 اقل من السابق MB 1,782 ! تحميل المرفق ميديا فير https://www.mediafire.com/file/10wstr8w0761kpj/Update_JRCalenderClock_2025_Ms_Access.rar/file Update_JRCalenderClock_2025_Ms_Access.rar

اشكرك على رأيك @غريب طرابلس لكل لغة ولها عيوب ونقط ضعف وبيدك استعمال آمن وتكلفة ممتازة افضل من هدر المال وارتفاع الاشتركات للبحث عن ثغرات وشاش اقصد على حسب الامكانيات العميل والي يطلب هذا الطلب غالب ان تكون شركة ولها فروع للتحصيل او حكومي بنطاق واسع وكليهما حسب نوع الخدمة ونطاق ويفضلون الآمن SH.. بنطور الاكسس جرب النافذه كامل الشاشة والعناصر كما هي اما بخصوص الدالة كل من طرق بستخدامها وسابق تعديل كان الريبن شريط الاكسس تشطيف وتعامل مع هذه الدالة استاذي @ابو جودي ☕❤️🌹 وبتحجيم الشاشة والعناصر والقياس واساتذه اخرى وحتى الاجنبي فدالة الي فوق افضلهم

استاذ @ابو جودي ❤️🌹☕☕ هي اضافة قواعد من سنة الى وصول السنة حتى لو وصلة 10 سنوات حسب الادخال والي نسيتة اضافة تسمية للانشاء قواعد اخترة ابصطها 😂وانت استاذي ما تقصر بسرط الدوال اتوقع عندك ملاحظة او نموذج للتأسيس يعني اصدمني بدالة استاذي بس جرب المرفق الا نازم وضع التصميم

=============================================( صور + مرفق + فيديو ) Update: 🌹 1- ادخال التقويم بالرصد الرسمي مع بعض التحسينات 2- قائمة الرصد الاجازات 3- ادخال الوقت مميز تجربة ممتعة ☕ JRCalenderClock_2025_Ms_Access.rar

=============================================( صور + مرفق + فيديو ) Update: 🌹 طلب استاذ @Foksh❤️🌹☕ تبيني اسويه عداد بيلر 😂 دورك ورني ابداعاتك استاذي @ابو جودي❤️🌹☕☕ اعتذر الآخر جاهز فيه كل الدول جاهز بس شوي تعديل وبرفع بس ضم مشروعك مسأل الواجهة تسجيل دخول والصلاحيات والتحكم جاهزه لو تعطني نظرة على هذا المرفق من غير طحن كل الدوال بدالة لو بدالة مفصلين بضم استكمال مع طلب المساعده 1- متوفر فيه معلومات وشرح طريقة انشاء شبكة محلية طيارة عن طريق كمبيوترك 3 خطوات 2- تعديل الدول لاحتساب الرسم البياني متقدم 3- اضافة تحديدث واختيار بدور 4- اضافة مكان مخصص للشبكة المحلية بالاول تسجل اسم الكمبيوترك الي بشبكة جهازك باول زر 2- اضافة تلقائية سريعة 6- حذف الملفات بالشبكة الاحتياطية مع خيار اخذ نسخة احتياطية 7- تجربة تسجيل دخول متقدم تعرف حجم القاعدة وتربط وتشتغل في الشبكة المحلية 8- ادوات اعادت الاتصال بشبكة المحلية مع غفلها او تنشيطها 9- رموز اسفل البار في حالة الاتصال بالانترنت مع حالة اتصالك الى جهاز آخر مو حاسوبكاقصد عند حاسوب اخر 10 - جعل بار في الاعلى بحرك بسيطه 11- استخدام القائم في الواجهة الفكرة اخذ اي مشروع في اكسس وحوله الى قواعد بيانات الميزه عند اعادة الربط يربط الكل في القاعد ويصفي القديم من غير كتابة اسم الجداول مع فحص متقدم سويت مذكرة مع قاعدة شوف الفيديو بسرعة يعني برنامج افراح وصالات او محاسبة كمل اشوي واستخدم معاها البرنامج او الاداة خل كل كمبيوتر في حالة المسئول نسخ كل القواعد لي ملفة ويربط فيهم التحديث بضغطة زر في طرق اسهل من غير تشعيب بعض من التصحيحات واستكمال ========================================= الاستكمال قريبا V1.6_GiveMe_File_Out_Size_File.rar

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

تفضل استاذ @Foksh 🌹❤️☕ تحديث انت ما تحب المعقدين 1- اضافة سحب ملف باسم بالمسار بعدد ملفات الفرعية في الملف وحجم الملف 2- اضافة استخراجهم برسالة 3- تغير طريقة مستعرض الملفات 4- الرسم البياني بشكل الدائرة - فقط جدول سهل للغاية حاضرين باي خدمات V1.4_GiveMe_File_Out_Size_File.rar

اهلا اهلا استاذي @ابو جودي ❤️🌹☕☕ اهلا استاذ @Foksh❤️🌹☕ استاذ @Foksh بدال تخلي الرسم ثلاثي من اقصى 2 جيجا الى حجم الملف برسم دائرة بيانية امخلينها عداد موتر الله يهداكم 😂 الافضل يكون الشغل اكثر احترافية تحديث بتطبيق اداة MultiPage (AcitveX) متقدم لا تنسى تفعيل المكتبات 1- اختيار ملف مره وحده الى تيرابايت 2- اختيار مجلد الى تيرابايت 3- اكتب المسار لو كان بالجدول الى تيرابايت 4- ادوات تحكم وتصحيح الخطأ عند اعادة التصميم MultiPage ينقصني تعديل لقراءة حجم المجلد مو الملف بص على الكود بسيط وجاري التعقيد Option Compare Database Option Explicit '_______________( المتغيرات العامة )___________________ Private LastProcessedPage As String ' لتتبع آخر تبويب تم التعامل معه Private LastClickTime As Date ' لتحديد وقت آخر ضغط Private Const CLICK_DELAY As Integer = 1 ' الحد الأدنى بين الضغطات (بالثواني) ' ثوابت الألوان Private Const TAB_NORMAL As Long = 15921906 ' رمادي فاتح Private Const TAB_ACTIVE As Long = 16777215 ' أبيض Private Const TAB_TEXT As Long = 0 ' أسود Private Const TAB_HOVER As Long = 14483455 ' أزرق فاتح Private Const BG_COLOR As Long = 12566463 ' أزرق غامق للخلفية Private Sub B0_Click() On Error GoTo ErrorHandler If IsNull(Me.B0) Or Me.B0 = "" Then ShowUserMessage "حدد نوع الخط ...( فارغ )", vbCritical Exit Sub End If With Me.MultiPage3 .FontName = Me.B0 End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub CH1_Click() On Error GoTo ErrorHandler If IsNull(Me.CH1) Or Me.CH1 = "" Then ShowUserMessage "حدد النمط من القائمة...( فارغ )", vbCritical Exit Sub End If With Me.MultiPage3 If Me.CH1 = 1 Then UpdateActiveTab .Style = Me.CH1 '=======( Buttons1 ) - ( Tabs0 ) - (None) -" Else .Style = Me.CH1 '=======( Buttons1 ) - ( Tabs0 ) - (None) -" End If End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub Ch2_Click() On Error GoTo ErrorHandler If IsNull(Me.Ch2) Or Me.Ch2 = "" Then ShowUserMessage "حدد تغير الاتجاهات...( فارغ )", vbCritical Exit Sub End If With Me.MultiPage3 .TabOrientation = Me.Ch2 '====(0)Top - (1)Buttm - (2)Right - (3)Left - " End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub Ch3_Click() On Error GoTo ErrorHandler If IsNull(Me.Ch3) Or Me.Ch3 = "" Then ShowUserMessage "حدد النمط من القائمة...( فارغ )", vbCritical Exit Sub End If With Me.MultiPage3 .SpecialEffect = Me.Ch3 End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub Color_2_Click() On Error GoTo ErrorHandler Me.cx3 = DialogColor(Me.cx3.BackColor) If IsNull(Me.cx3) Or Me.cx3 = "" Then Else Me.pack2.BackColor = Me.cx3 With Me.MultiPage3 .ForeColor = Me.cx3 End With End If Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub color_Click() On Error GoTo ErrorHandler Me.cx2 = DialogColor(Me.cx2.BackColor) If IsNull(Me.cx2) Or Me.cx2 = "" Then Else Me.Pack.BackColor = Me.cx2 End If With Me.MultiPage3 .BackColor = Me.cx2 'COLOR_NORMAL End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub Form_Close() '__________( اغلاق والحفظ تهيئة القائمة )____________ Call Menu_X_Click End Sub Private Sub Form_Load() ' تهيئة القيم الأولية LastProcessedPage = "" Call Menu_X_Click End Sub Private Sub Form_Open(Cancel As Integer) Me.h = Me.InsideHeight Me.w = Me.InsideWidth Me.z1 = 0 Me.z2 = 0 Me.z3 = 0 End Sub Private Sub Menu_X_Click() On Error Resume Next With Me.MultiPage3 '.Parent = Page '.Caption = btnCaption ' .Left = Left ' .Top = Top .Width = 2000 .Height = 7665 .FontName = "Segoe UI" .FontBold = True .Font.size = 10 '===================( Nurmail ) .BackColor = rgb(260, 260, 260) 'COLOR_NORMAL .ForeColor = rgb(0, 0, 0) ' black Color .BorderColor = rgb(220, 220, 220) .BorderShade = rgb(180, 180, 180) ' .BackColor = RGB(51, 153, 255) ' .ForeColor = RGB(149, 179, 215) .TabOrientation = 3 '====(0)Top - (1)Buttm - (2)Right - (3)Left - " .Style = 0 '=======( Buttons1 ) - ( Tabs0 ) - (None) -" .MultiRow = True .TabFixedWidth = 80 .TabFixedHeight = 20 .BorderStyle = fmBorderStyleSingle '.SpecialEffect = fmSpecialEffectFlat .SpecialEffect = fmSpecialEffectEtched .MousePointer = fmMousePointerCustom '.BackStyle = fmBackStyleOpaque '.OnClick = "[Event Procedure]" Exit Sub End With End Sub Private Sub MultiPage3_Change() On Error GoTo ErrorHandler '_________________( الحدث الرئيسي )__________________ Dim currentPage As String ' currentPage = Me.MultiPage3.SelectedItem.Caption currentPage = CleanPageName(Me.MultiPage3.SelectedItem.Caption) '______________( التحقق من التكرار )___________ If currentPage = LastProcessedPage Then Exit Sub If currentPage = LastProcessedPage And _ DateDiff("s", LastClickTime, Now) < CLICK_DELAY Then Exit Sub End If '__________( معالجة الأوامر حسب الصفحة )________ Select Case currentPage '________________________________________________________________________ Case "MsgboxTest1" MsgBox "جاري فتح لوحة العملاء...", vbInformation, Date ' Call X '________________________________________________________________________ Case "MsgboxTest2" ShowUserMessage "جاري تحميل قائمة المنتجات...", vbInformation '________________________________________________________________________ Case "selected_Folder" Dim DL As Office.fileDialog Dim sizeInfo As String Set DL = Application.fileDialog(msoFileDialogFolderPicker) If DL.Show Then Call GetSelected_Path_DatabaseSize(DL.SelectedItems(1)) sizeInfo = GetSelected_Path_DatabaseSize(DL.SelectedItems(1)) Me.size = sizeInfo End If '________________________________________________________________________ Case "Selected_File_db" Dim sizeInfox As String Dim path_x As String Dim DLX As Office.fileDialog Set DLX = Application.fileDialog(msoFileDialogFilePicker) If DLX.Show Then path_x = DLX.SelectedItems(1) Call GetSelected_Path_DatabaseSize(path_x) sizeInfox = GetSelected_Path_DatabaseSize(path_x) Me.F5 = sizeInfox End If Case Else ' يمكنك إضافة صفحات أخرى هنا End Select '____( تحديث السجل الأخير )____ LastProcessedPage = currentPage Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub sz_Click() On Error GoTo ErrorHandler If IsNull(Me.sz) Or Me.sz = "" Then ShowUserMessage "حدد حجم الخط ...( فارغ )", vbCritical Exit Sub End If With Me.MultiPage3 .Font.size = Me.sz End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub ' Private Sub sizedb_Click() ' Dim sizeInfo As String ' ' Call GetSelectedDatabaseSize ' ' sizeInfo = GetSelectedDatabaseSize() ' Me.size = sizeInfo ' ' End Sub Private Sub xxx_Click() Dim sizeInfo As String If IsNull(Me.path) Or Me.path = "" Then MsgBox " الرجاء كتابة مسار قاعدة البيانات ", vbExclamation Exit Sub End If Call GetSelected_Path_DatabaseSize(Me.path) sizeInfo = GetSelected_Path_DatabaseSize(Me.path) Me.size_path = sizeInfo End Sub Private Sub UpdateActiveTab() On Error Resume Next Dim i As Integer With Me.MultiPage3 ' إعادة تعيين جميع التبويبات For i = 0 To .Pages.Count - 1 If Me.MultiPage3.SelectedItem.Caption = "page1" Then .BackColor = TAB_ACTIVE .ForeColor = rgb(0, 0, 139) ' أزرق غامق .FontBold = True Else .Pages(i).BackColor = TAB_NORMAL .Pages(i).ForeColor = TAB_TEXT .Pages(i).FontBold = False End If Next i ' تمييز التبويب النشط If .Pages.Count > 0 Then With .Pages(.Value) .BackColor = TAB_ACTIVE .ForeColor = rgb(0, 0, 139) ' أزرق غامق .FontBold = True End With End If End With End Sub '_______________( الدوال المساعدة )_________________ Private Function CleanPageName(rawName As String) As String ' تنظيف اسم الصفحة من أي إضافات CleanPageName = Replace(Replace(rawName, "\", ""), "/", "") End Function Private Sub ShowUserMessage(msg As String, iconType As VbMsgBoxStyle) ' عرض رسائل المستخدم بشكل منسق Dim msgText As String msgText = "System Notification" & vbCrLf & String(50, "?") & vbCrLf & msg MsgBox msgText, iconType + vbSystemModal, "نظام الإدارة" End Sub Private Sub X() Dim i As Integer With Me.MultiPage3 For i = 0 To .Pages.Count - 1 If Me.MultiPage3.SelectedItem.Index = i Then ' .BackColor = TAB_ACTIVE .ForeColor = rgb(0, 0, 139) ' أزرق غامق .FontBold = True Else ' .Pages(i).BackColor = TAB_NORMAL .Pages(i).ForeColor = TAB_TEXT .Pages(i).FontBold = False End If Next i End With End Sub Private Sub z1_Click() On Error GoTo ErrorHandler With Me.MultiPage3 If Me.z1 = 0 Then .FontUnderline = False Else .FontUnderline = True End If End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub z2_Click() On Error GoTo ErrorHandler With Me.MultiPage3 If Me.z2 = 0 Then .FontItalic = False Else .FontItalic = True End If End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub z3_Click() On Error GoTo ErrorHandler With Me.MultiPage3 If Me.z3 = 0 Then .FontBold = False Else .FontBold = True End If End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub V1_GiveMe_File_Out_Size_File.rar

قبل تجهيز النظام للرفع لكم لانشاء نظامكم - خفايف كود موضح في المرفق تجربة ممتعة GiveMe_File_Out_Size_File.rar

قبل تجهيز النظام للرفع لكم لانشاء نظامكم - خفايف كود موضح في المرفق ترجبة ممتعة Screen_Mix_Form_Ms_Access.rar

=============================================( صور + مرفق + فيديو ) Update: 🌹 استكمال ☕ 1-اضافة معيار البحث 1(مطابق)2(باي حرف في الكلمة)3(يبدا اول حرف من الكلمة )4(ينتهي اخر حرف بالكلمة)5(عرض الكل)* في فورم واحد فقط تمرر علي اسم الجدول الادخال 2- تعديل في الواجهة الى الون الابيض مع اضافة ايكون متحرك من الفورم وليس من المتصفحة كود 100 Exit sub Only Code = one 1 Scend 3- تعديل كود QR فقط ادخال الحقول المطلوبة ولا يتطلب تثبيت ولا نقل ملفات الى ملفات نظام ولا الانترنت 4-تفعيل خيار بحث متعدد للتقارير مع الفرز وحتى لو كان غير مسجل بلوح النظام Super Qury 5- تصحيح وتعديل بعض من التصاميم + اضافة ادوات اكثر اذا تعتمد نافذة تسجيل دخول للمستخدم + تحديد مسار حفظ QR ..+ بعض من التصحيحات واستكمال اضافة نافذة خاص للمسارات QR $ جدول مفاتيح المتسلسلة للجدول اما تكون بدالة او فقط دالة كسلاسل غير منتهية Function لتعدد مسار المستقبل من اجدول ID: Number_ID,Text_Number,Yers YYYY 1A12025 عند بلوغ حد المحدد كأقصى سجل للحفض بجداول الدوران 1A00000000000002025 يصيح 1B12025 عند الوصول الى آخر حرف Z يصبح 1AA12025 لحين انتهاء السنة الى السنة الجديده يصبح 1A12026 ========================================= الاستكمال قريبا

=============================================( صور + مرفق + فيديو ) Update: 🌹 بعد اذن استاذي @ابو جودي ☕🌹❤️ اسأل اذا في دالة للفرز التقرير ولاي تقرير تكون افضل من الكود 😇 استكمال ☕ 1-اضافة نافذه واحده لادخال المدخلات فقط حدد الجدول والحقل ونموذج والى الحقل كود استدعاء بسيط كود عند النقر المزدوج : '===================================( Only Copy this Dim name as sours type Dim strMsg_Give_Nmae As Response Dim Run_Cod1 As Integer Dim s2 As Integer Dim iprgrs As Long Dim MsG1 As String Dim MsG2 As String Dim MsG3 As String Dim strMsg_X As String Dim Title_X As String Dim SubTitle_X As String On Error GoTo ops If Me.Job_with_Me = "%" Then If DCount("[ID]", "[ÕÝÉ_ÇáãÑÇÌÚ]") = 0 Then MsG2 = "Sand Massage !" MsG1 = "áÇ íæÌÏ ÈíÇäÇÊ ãÖÇÝÉ" MsG3 = "ÇáÑÌÇÁ ÇáÇÊÕÇá Úáì ãÑßÒ ÇáãÚáæãÇÊ áÇÖÇÝÉ ãæÇÑÏ ÇáÇÎÇá ÑÞã 1300 ( ÈíÇäÇÊ ÝÇÑÛÉ 0 ) ¿! " MyMsgBox (MsG3), (MsG2), (MsG1), msg_Exclamation, Btn_OK_Only, Arabic_Center ',True, 2.5 DoCmd.close acForm, Me.Form.nmae Exit Sub End If '==============( Open Form with Form name ( 1 DoCmd.openForm "X_Into_Menu" Form_X_Into_Menu.frm = "Data_Customer_File" 'Me.Form.name '============== ( Give name textbox for save value Form_X_Into_Menu.button = "Job_with_Me" '===================(name SubForm 2 IF No = "" Null Form_X_Into_Menu.Frm0 = Me.Form.name '===========================( Selected Name Tablet For INto ) Form_X_Into_Menu.TB = "ÕÝÉ_ÇáãÑÇÌÚ" '===========================( Selected Name Filde One In Tablet For INto ) 'Form_X_Into_Menu.FD = Me.Form.name '=========================================( text About Into Phone Form_X_Into_Menu.TxtSubTitle = "ÕÝÉ_ÇáãÑÇÌÚ" 'Form_X_Into_Menu.txtMSG = "íãßäß ÊÚÏíá ÇáÚäæÇä æÇáãæÖæÚ ÇáãÎÕÕ ááÊæÖíÍ ááãÓÊÎÏã ÞÈá ÇáÇÏÎÇá" '================================================( Give Value Form Into Form To Form In Form One 1 ' Me.SGG = DLookup("[Input_Mask_IN]", "[InputMask_InTo_Msgbox]") End If '-----------------------------------------------------------------------( For Error Code Only Copy And No Can use Function = Here Error :) X exit_Ops: Exit Sub ops: Dim Error_Finction As String Error_Finction = err.Number & ":" & err.Description _ & ":" & Me.ActiveControl.name & ":" & Me.Form.name Error_Now (Error_Finction) DoEvents Resume exit_Ops Exit Sub - مع امكانية الاضافة سجل جديد بالجدول المحدد - قريبا عمل دالة ضم كل من ادوات الادخال 😇 2- تعديل على كافة نوافذ الاخال للتستقبل النموذج الفريع او لا بكود استعداء بسيط 3- اضافة ميزة كتابة داخل الحقول رمز "%" لتشغيل محرك الادخال 4- اضافة اداة الفرز تصاعدي وتنازلي للتقارير (A-Z )بكود بسيط مع بعض التعديل من الكود : '================================(Name Report Only) DoCmd.ShowToolbar "Ribbon", acToolbarNo DoCmd.openForm "top_report" Form_Top_Report.Name_report.Caption = "Zr" 'Me.repp DoCmd.openReport "Zr", acViewPreview '================================( A-z ) '===============================================( 1) If Me.AZ1 = 1 Then If IsNull(DLookup("[From_day_Fild]", "[SH_All_Report]", "[Open_Report] ='" & Me.repp & "'")) Then Else 'DLookup("[From_day_Fild]", "[SH_All_Report]", "[Open_Report] ='" & Me.repp & "'") Reports(Me.repp).OrderBy = "ÊÇÑíÎ ÇáÊÚííä" & " ASC" Reports(Me.repp).OrderByOn = True End If End If If Me.AZ1 = 2 Then If IsNull(DLookup("[From_day_Fild]", "[SH_All_Report]", "[Open_Report] ='" & Me.repp & "'")) Then Else Reports(Me.repp).OrderBy = "ÊÇÑíÎ ÇáÊÚííä" & " DESC" Reports(Me.repp).OrderByOn = True End If End If '===============================================( 2) نسيت تعديل على الكود عند الفتح الكل ="" ماعدا المحدد A-Z 5-اصلاح بعض الاخطاء عند تسجيل خروج 6- اضافة دليل الهاتف والاثبتات من المراجعين والموظفين - اضافة فلترة سريع من غير SQL * امكانية تغير النمط والاحتفاظ كثيم للواجهة الرئيسية فقط نسق الاوان في قائمة النوافذ غيرة من الوردي الى الازرق (( تابع الفيديو )) ..+ بعض من التصحيحات واستكمال ========================================= الاستكمال قريبا

=============================================( صور + مرفق + فيديو ) Update: 🌹 استكمال ☕ 1- اضافة قائمة ادخال للسكانر (ماسح الضوئي للمستندات) بنافذه واحده فقط -يعمل بتحديد اي جدول وحقل واحد فقط 2- اضافة فيديوات كان للشرح وتوضيح او محاضره 3- اضافة تسجيل الدخول للمستخدمين 4-تحسين واصلاح الاخطاء بتغير واختيار عرض واجهة الرئيسية 5- تعديل لعرض التقارير 6- اضافة اعدادة اكثر ...+ بعض من التصحيحات واستكمال ========================================= الاستكمال قريبا تحميل المرفق https://www.mediafire.com/file/2ye27loo61jum83/14-3-2025_UpDate_Sys_Object.rar/file

استاذي العزيز @ابو جودي ❤️🌹🌹☕ في دالة اتذكر انا سويتها لحصر الارقام من الشمال الى اليمين مع تحديد عدد ارقام المدني القومي لكافة الدول 😇 ( حقل واحد )التقرير يكون حقل متصل برقم المدني القومي لاختلاف اعداد الرقم المدني القومي من دولة الى اخرى لو عندي فك لشفرة ارقام المدنية القومية للدول الاخرى لرفقتها لسرعة ادخال البيانات واشرايك تاخذ الرقم بتمرير الكاميرا في (في قلم تمسح على ورقة او على بطاقة ينقل نص مباشر الى الحقل يمكن الشراء وتجربة في امازون او محلات الكمبيوتر اتذكر كان نازل قبل جائحة اكرونا) مجهزا لكم تحديث باقرب وقت ارفعة قبل لا اكمل نطاق الجغرافي 2 اقصد الي قبله فيه الصلاحيات والاعدادة بختصار نظام ينشأ نظام كالاوريكل نفس الطريقة لانشاء وتصميم الاوريكل ولكن نظام اسرع من الاوركيل وخيارات متعدده لانجاز مشروعك يمكن انا الوحيده الى سوت نظام لينشأ نظام في الموقع شوف لي نظره على المشروع بعد ما ارفع

: تحديث *على السريع * الي يحب تغير واجهة مشروعه 1- اضافة تركز عند تحريك النافذه بختيار لون من ذوقك 2- تغير حواف اطار النافذه الى حواف من الزر 3D 3-اضافة عرض التقرير بكامل حجم التقرير وليس فوق بعض مه ادوات عرض التقرير 4- بعض التصحيح مثال عند تكبير الشاشة تعطيل تحريك النافذه والعكس مع بعض من التعديلات 5- تطبيق ايكون متحرك Gif عند شريط الساعة واعتذر عن تحديثات او الاضافة او مساعدة لتعليق عضو للمراقبة لما العجوزه او العجوز يقول مصحه اشكر استاذ @محمد طاهر عرفه ☕❤️🌹 تحميل المرفق https://www.mediafire.com/file/0e3pabj18mw84ib/Update_7-2-2025_Show_Gif_Move_Control.rar/file

: تحديث *على السريع * 1- تفعيل التركيز النموذج عتد فتح بتغير اللون الاطار مع تغير الغيرالنموذج نشط 2- تصحيح الكود 😇 Update_Show_Gif_Move_Control.rar

من غير دوال *على السريع * :ملاحظة لبعض الموضوعات ملائمة الشاشة😇 انسخ مشروعك لكل دقة شاشة وتصميم نافذة خصيص لدقة الشاشة انت تفتح بقاعدة النماذج بسيط آخرى للفحص فقط تأخذ الدقة الشاشة الحالية وتشغيل قاعدة النماذج المشروع وربط الجداول مشروعك (فقط) ثم الاغلاق قاعدة الفحص بسيطه الصيام المفترض بعد المغرب دوام يبدا من 7 الى الساعة 11 ويسمح الى 2 فجرا بس الحبايب لازم يحرمونهم اجازه ما يتهنون بعد سنة دوام المفروض يسافرون = للثلث وليس الكل والبعض ضب معسور ما يستفيدون ما تفرق معاهم !!والي يفكر بسبب بيع الاجازات

وجهة نظر 😇 تقصد اي تعديل جديد بالاضافة او الازالة جدول + نماذج ! يعتبر تحديث وفصل القديم بتصحيحات فقط نماذج = خطأ 😁 التحديث بالكمية او بتغيرات او يكون بالسنة لطلبات محدده برقم FE BE القديم يشمل كل من التعديلات والاضافات وتصحيحات (0)- اختيار نوع التحديث + INFO App Customer V?! + New date + Number Update انواع : (1)- تحديث متكامل 1- نموذج استبدال كل FE (Path one Onle New) = At Open FE Old Frist Chack IF Update = Run Link db K 2- الحاق البيانات القديمية الى الفارغ الجديد الجدوال - استخدم DOA Path db_New To Path db_Old ' SQL = SELECT MSysObjects.Name FROM MSysObjects WHERE (((MSysObjects.Type)=1 Or (MSysObjects.Type)=4 Or (MSysObjects.Type)=6) AND ((InStr([Name],"~"))=0) AND ((InStr([Name],"MSys"))=0)); For Each Tb In Next 'Updat = Selected Update =-1 rs.Close db1.Clos db2.colse او فقط تمرير السكول في الجدول ============================= (2)- تحديث تصحيح النماذج او الجداول فقط استبدال النماذج الحاق ثم استبدال بتغير المسار جديد للجداول ============================= (3)- تحديث الجداول الارتباط و تحديث جداول العامة او ارتباط بالجداول الخاصة كعداداة لنظام (4)- عند الانتهاء سؤال هل ترغب بالتشغيل التحديث + كل التحديثات في جدول مرتبط يتضمن جدول كافة التحديثات ويكون اما في(( السرفر او باي مسار )) اذا يسمح المركز ان يتم التحدث اولا كموافقة User = K1 And K2 Form Date < Today Run Update

=============================================( صور + مرفق + فيديو ) Update: 🌹 هل من توجيهات بخصوص) ؟!(SQL موحد الاختلاف بمراحل عن (Function )! ,وتحفظ كل الاتسعلامات في الجدول 😇 استكمال ☕ 1- اضافة استعلام واحد فقط لكافة التقارير او مع النماذج (Super_SQL)😁 - اضافة اداة لجلب السكول للتقرير و لقائمة المنسدلة وتكتفي بالاختيار قوائم المندلة من اسم الجدول والحل مع التسمية - بزر جلب السكول فقط لصق من غير اي تعديل حتى قوائم المنسدلة لصق فقط من غير تعديل ملاحظة يجب اغلاق Logen ثم الفتح بتحديث القادم 2- اضافة قائمة ادخال موارد النظام الازرار تزيد او تحثف من غير الرجوع الى التصميم مع + خلفية متحرك وشعار والنص 3- اضافة تعديل على الرموز للقوائم ولون وعند الضغط للواجهة الرئيسية 4- تصحيح الكيبورد لان تم تعديل ونسيت اعدل على الكود فعدلته في هذا التحديث 5- تصحيحات متفرقة مثل رسائل تنبية للقوائم غير عند الضغط .. مع بعض التعديلات ...+ بعض من التصحيحات واستكمال ========================================= الاستكمال قريبا تحميل المرفق https://www.mediafire.com/file/97224ddlkfzzojq/27-2-2025_Update_V4_SQL_Set_One_Rep_Frm.rar/file

=============================================( صور + مرفق + فيديو ) Edit: 🌹 بعد اذن الاستاذ @عبد اللطيف سلوم 🌹❤️☕ عدلة على مرفقك 😇 بنسبة لافضل حل من غير تغير التاريخ بتغير الوقت ان تفصل كل من التاريخ والوقت والتوقيت لعمل ضبط المواعيد او العمل فتره الدائم ملاحظة عند تغير التوقيت احتمال يزيد يوم او ينقص بيوم مثال بسيط عند الساعة و 1:00:00 AM (1/2/2026) عند التغير التوقيت من ( AM To PM ) عند الساعة و 1:00:00 PM (2/2/2026) يعتبر احتساب الى اليوم التالي والعكس ينقص ويصبح من التاريخ (2/2/2026) الى (1/2/2026) ! ان كان التاريخ ثابت يتغير التوقيت اما تغير المواعيد دائم في المساء يمكنك التعديل منذ بداية وان صادف ايام الاجازة والعطل الرسمية يضيف 2 يوم او 3 ايام ليصادف العمل الرسمي وذا كنت تحب العمل بتعديل التلقائي بعد تعديل التوقيت ولا تنسى تحديد توقيت العمل بساعات ودقائق والثواني من بداية العمل الى نهاية العمل لتعديل التواقيت والاضافة ولتفادي اخطاء المستخدمين عند الادخال وعند حجز المواعيد ! 1-لكافة السجلات في الجدول كود : Dim strsq2 As String Dim Time_A_P As String Dim newTime As Date On Error GoTo ops '==========================( Frist Cahck If IsNull(Me.timeer_X) Or Me.timeer_X = "" Then MsgBox " No Teme is Selected Teme ,ISNull Time, U Into Time Agen Back Click Button ", vbExclamation, "Close Don " Exit Sub End If If DCount("[timeer]", "[timerr]") = 0 Then MsgBox "Close Don ,U Not Any Add New Record For Run Don , U Add New Time Agen Back Click Button ", vbCritical, "Close Don " Exit Sub End If If Me.PM = -1 Then Time_A_P = "PM" End If If Me.AM = -1 Then Time_A_P = "AM" End If strsq2 = "Update timerr Set PM_AM = '" & Time_A_P & "'" CurrentDb.Execute strsq2 DoEvents Me.Refresh '-----------------------------------------------------------------------( For Error Code Only Copy And No Can use Function = Here Error :) X exit_Ops: Exit Sub ops: Dim Error_Finction As String Error_Finction = Err.Number & ":" & Err.Description _ & ":" & Me.ActiveControl.Name & ":" & Me.Form.Name MsgBox Error_Finction DoEvents Resume exit_Ops Exit Sub 2- لتغير سجل اما في اليوم او الوقت او التوقيت 3- اضافة توقيت جديد 4- اضافة فحص وتعديل بسيط تحميل في المرفق Change_Dy_Time_All_Table.rar

=============================================( صور + مرفق + فيديو ) Update: 🌹 استكمال ☕ 1- تعديل واضافة ادخال مع امكانية اختيار ادخال الارقام والرموز + كود : Private Sub DayX_KeyPress(KeyAscii As Integer) '==============================( with Control In tablet ( Form Or report , Name.Button.Activit ) If = True Or Flase Or Only number '=======================( Only Set 1 for Run into Keybord And 0-Close All = No Selected Normal InTo Keybord Dim Number As Long Dim Arabic As Long Dim English As Long Dim Sombl As Long Dim Letters As Long Dim English_Smoll As Long Dim English_captil As Long '===================================( Only Copy this Dim name as sours type Msbox Only Dim MsG1 As String Dim MsG2 As String Dim MsG3 As String '=======================================( Raw Chack Dim k As Long Dim n As Integer Dim Chkstr As String 'Number Dim Chkstr1 As String 'Sombil '****************************************( Ues Any tybe into TextBox True = 1 Or False = 0 ) Selected_Objecte Number = 1 Sombl = 0 '===================( Only One Selected (1) Arabic = 0 English = 0 Letters = 0 English_Smoll = 0 English_captil = 0 '***************************************** On Error Resume Next If Number = 1 Then '================================( Only Number Chkstr = "0123456789" Chkstr1 = "[!@#$%^&*()_+{}:<>?~]" If KeyAscii > 26 Then ' Ctrl No Selcted Click Keybord and with any KeyBord To 26 If InStr(1, Chkstr, Chr(KeyAscii)) = 0 Then If Sombl = 1 Then If InStr(1, Chkstr1, Chr(KeyAscii)) = 0 Then KeyAscii = 0 MsG2 = "Sand Massage !" MsG1 = "ÊäÈíÜÜÜÜÜÜÜÜå !" MsG3 = "ÇáÑÌÇÁ ÇÏÎá ÑãæÒ ÝÞØ " MyMsgBox (MsG3), (MsG2), (MsG1), msg_No_User, Btn_OK_Only, Arabic_Center ',True, 2.5 End If Else KeyAscii = 0 MsG2 = "Sand Massage !" MsG1 = "ÊäÈíÜÜÜÜÜÜÜÜå !" MsG3 = "ÇáÑÌÇÁ ÇÏÎá ÇÑÞÇã ÝÞØ " MyMsgBox (MsG3), (MsG2), (MsG1), msg_No_User, Btn_OK_Only, Arabic_Center ',True, 2.5 End If End If End If End If If Sombl = 1 Then '================================( Only Smbil Chkstr1 = "[!@#$%^&*()_+{}:<>?~]" Chkstr = "0123456789" If KeyAscii > 26 Then ' Ctrl No Selcted Click Keybord and with any KeyBord To 26 Ctrl If InStr(1, Chkstr1, Chr(KeyAscii)) = 0 Then If Number = 1 Then If InStr(1, Chkstr, Chr(KeyAscii)) = 0 Then KeyAscii = 0 MsG2 = "Sand Massage !" MsG1 = "ÊäÈíÜÜÜÜÜÜÜÜå !" MsG3 = "ÇáÑÌÇÁ ÇÏÎá ÇÑÞÇã ÝÞØ " MyMsgBox (MsG3), (MsG2), (MsG1), msg_No_User, Btn_OK_Only, Arabic_Center ',True, 2.5 End If Else KeyAscii = 0 MsG2 = "Sand Massage !" MsG1 = "ÊäÈíÜÜÜÜÜÜÜÜå !" MsG3 = "ÇáÑÌÇÁ ÇÏÎá ÑãæÒ ÝÞØ " MyMsgBox (MsG3), (MsG2), (MsG1), msg_No_User, Btn_OK_Only, Arabic_Center ',True, 2.5 End If End If End If End If If Arabic = 1 Then Select Case KeyAscii Case 97 To 122, 65 To 90, 48 To 57 KeyAscii = 0 MsG2 = "Sand Massage !" MsG1 = "ÊäÈíÜÜÜÜÜÜÜÜå !" MsG3 = "ÇáÑÌÇÁ ÇÏÎá ÍÑæÝÇð ÚÑÈíÉ ÝÞØ" MyMsgBox (MsG3), (MsG2), (MsG1), msg_No_User, Btn_OK_Only, Arabic_Center ',True, 2.5 End Select End If If English = 1 Then '================================( Only En captil And Smoll If Chr(KeyAscii) Like "[0123456789.]" Then KeyAscii = 0 MsG2 = "Sand Massage !" MsG1 = "ÊäÈíÜÜÜÜÜÜÜÜå !" MsG3 = "ÇáÑÌÇÁ ÇÏÎá ÍÑæÝÇð ÃÌäÈíÉ ÝÞØ" MyMsgBox (MsG3), (MsG2), (MsG1), msg_No_User, Btn_OK_Only, Arabic_Center ',True, 2.5 End If End If If Letters = 1 Then '================================( Only into Letters Select Case KeyAscii Case 48 To 57, 32 '(Close SPACE) KeyAscii = 0 MsG2 = "Sand Massage !" MsG1 = "ÊäÈíÜÜÜÜÜÜÜÜå !" MsG3 = "ÇáÑÌÇÁ ÇÏÎá ÇÍÑÝ ÝÞØ" MyMsgBox (MsG3), (MsG2), (MsG1), msg_No_User, Btn_OK_Only, Arabic_Center ',True, 2.5 End Select End If If English_Smoll = 1 Then '================================( Only EN Smoll Select Case KeyAscii Case 65 To 90 KeyAscii = 0 MsG2 = "Sand Massage !" MsG1 = "ÊäÈíÜÜÜÜÜÜÜÜå !" MsG3 = "ÇáÑÌÇÁ ÇÏÎá ÍÑæÝÇð ÇÌäáíÒíÉ ÕÛíÑå ÝÞØ" MyMsgBox (MsG3), (MsG2), (MsG1), msg_No_User, Btn_OK_Only, Arabic_Center ',True, 2.5 End Select If Chr(KeyAscii) Like "[0123456789.]" Then KeyAscii = 0 MsG2 = "Sand Massage !" MsG1 = "ÊäÈíÜÜÜÜÜÜÜÜå !" MsG3 = "ÇáÑÌÇÁ ÇÏÎá ÍÑæÝÇð ÃÌäÈíÉ ÝÞØ" MyMsgBox (MsG3), (MsG2), (MsG1), msg_No_User, Btn_OK_Only, Arabic_Center ',True, 2.5 End If End If If English_captil = 1 Then '================================( Only En captil Select Case KeyAscii Case 97 To 122 KeyAscii = 0 MsG2 = "Sand Massage !" MsG1 = "ÊäÈíÜÜÜÜÜÜÜÜå !" MsG3 = "ÇáÑÌÇÁ ÇÏÎá ÍÑæÝÇð ÇäÌáíÒíÉ ßÈíÑå ÝÞØ" MyMsgBox (MsG3), (MsG2), (MsG1), msg_No_User, Btn_OK_Only, Arabic_Center ',True, 2.5 End Select If Chr(KeyAscii) Like "[0123456789.]" Then KeyAscii = 0 MsG2 = "Sand Massage !" MsG1 = "ÊäÈíÜÜÜÜÜÜÜÜå !" MsG3 = "ÇáÑÌÇÁ ÇÏÎá ÍÑæÝÇð ÃÌäÈíÉ ÝÞØ" MyMsgBox (MsG3), (MsG2), (MsG1), msg_No_User, Btn_OK_Only, Arabic_Center ',True, 2.5 End If End If 2- اضافة راسالة بشريط الوندوز عند التنبيهات مع تحديد نوع الرسالة + عنوان ونص الرسالة + اختيار ايكون بالمسار عند اي حدث كان زر او الفتح او التحميل كود : '***********************************( SET ICON APP MS.ACCESS ON Notification Area of Taskbar IN MS ACCESS ) ***************** Dim Run_Msgbox_N_Finction As String Dim Slected_Type_Msgbox As String Dim Slected_Text_Msgbox As String Dim Slected_Heading_Msgbox As String Dim Slected_ICon_Path_Msgbox As String ' ====( 32X32_Size_Image ) '*******************************(Massage Open Selected ) **************************** '========================( Selected = (0)-No-Massage Show (1)-None (2)-Information (3)-warring (4)-Crictical ) Slected_Type_Msgbox = "2" '*********************************************************************************** Slected_Heading_Msgbox = " äÙÇã ÊÓÌíá ÏÎæá ÇáãÓÊÎÏã" Slected_Text_Msgbox = "ÊäÈíå ÞÈá ÇáÔÑæÚ ÈÇáÊÓÌíá ÇáÏÎæá Çä áã Êßä ãæÙÝ ÇáãÎÊÕ æÇáãÕÑÍ áå " & Now() Slected_ICon_Path_Msgbox = "D:\Tools\icon32\06-NeXT98 History.ico" '========( Finsh_Object ) Run_Msgbox_N_Finction = "*" & Slected_Type_Msgbox & "*" & Slected_Heading_Msgbox _ & "*" & Slected_Text_Msgbox & "*" & Slected_ICon_Path_Msgbox & "*" & Me.Form.name & "*" Selected_Show_Msgbox_Notification_Area_of_Taskbar (Run_Msgbox_N_Finction) 3- تعديل اكواد النماذج وجعلها دالتين مع اعدادة نمط عرض النظام او البرنامج الدالة : '***************************************************( Function Hide the Access window Good If DLookup("[OpenShow]", "[Screen_Control]") = 1 Then ' Call RestoreNormalWindow ' ShowRibbon 'v3.43 Call Seystem_Control_Window_Form(Me.Form.name) End If If DLookup("[OpenShow]", "[Screen_Control]") = 2 Then ' Hide the Access window and adjust its position with transparent form By Png Photos ' HideAccessAndShowUI Me, True For Run_window = 1 To 1 Call Seystem_Control_Window_Form(Me.Form.name) Next ' Hide the Access window and adjust its position HideAccessAndShowUI ' Center the form on the screen CenterObject Me End If If DLookup("[OpenShow]", "[Screen_Control]") = 3 Then Call HIDE_Full_Screen_Back_wallbaber Call Seystem_Control_Window_Form(Me.Form.name) End If '=========================(name_Function : User_MoD_Admin Call Seystem_Control_keybord(Me.Form.name) 'Call Seystem_Control_Window_Form(Me.Form.name) '**************************************************************** وتكتفي بالكود : '=========================(name_Function : User_MoD_Admin Call Seystem_Control_keybord(Me.Form.name) Call Seystem_Control_Window_Form(Me.Form.name) 4- اضافة زر تصغير النافذه + تصغير الى جوار الساعة '=====================================( Minimize_To_Taskbar window App ) Call Minimize_To_Taskbar(Me.Form.name) 5- اضافة قائمة ادخال التواريخ ميلادي او هجري او كليهما + توقيت 6- تفعيل ترصيد الاجازات بالايام والشهر والسنة ان تكون بداية الارقام 01 او 09 ...10 مع فحص التاريخ 7- ترصيد ايام العمل الرسمي والعطل بالواجهة الرئيسية 8- تصحيح وتعديل بعض 9- اضافة العوده الى وضع التصميم عند قائمة التسجيل الدخول 10- اختيار تشغيل اما مخفي او خليفية مع تحديد اللون او صورة خلفية او بوضع التشغيل 11- تحديد معيار دقة الشاشة لتشغيل النظام لا يمكن الفتح منذ بالداية الى بدقة شاشة الويندوز المطلوبة للتشغيل فقط تفعيل فحص دقة ...+ بعض من التصحيحات واستكمال ========================================= الاستكمال قريبا تحميل المرفق https://www.mediafire.com/file/dwl1prg9aclf0s2/Update21-2-2025_V3_Contol.rar/file