hanan_ms

=============================================( صور + مرفق + فيديو ) 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

=============================================( صور + مرفق + فيديو ) Update: 🌹 بعد اذن استاذي @ابو جودي ❤️🌹🌹☕ استخدمة تخصيص الطابعات استاذ @Foksh❤️🌹 هل صحيح استخدم طريقة التحميل الملف او استخدم دالة بطريقة ثانية (مسار الملف)اذا تبي تشغل تحميل ملف من الانترنت يوجد دالة وكود يحدد المكان الملف عند النموذج كل ثانية او 5 ثواني يجلب حجم الملف في المسار المحدد كمتغير بزياد الحجم باضافة نموذج بشريط الانتظار اذا لم يزيد حجم الملف يعني يساوي الرقم = حجم الملف ثابت ينتهي التحميل مع فحص كل ثانية اتصال بالانترنت 😇 استكمال ☕ 1- تعديل استعلام البحث 4 + 1 لكل انشاء القوائم بالواجهة الرئيسية يعني بحث مدرج من الوزارة الى الادار الى القسم او تبحث عن اسم القائمة للكل - ان تنشأ استعلام وحفظ ثم تدرجة باستعلام الفورم k Cod SQL : Like "*" & [Forms]![Menu_Editor_FormNew]![f2] & "*" Or Is Null لاظهار حقول الفارغة تجد الاستعلام على سبيل المثال Menu_Report 2- اضافة ادخال الكيبورد اما ارقام فقط او لغة عربية او لغة انجليزية او ادخال فقط احرف (الكل في كود واحد لكل حقل نص) حدث: عند الضغط على المفاتيح فقط اختر الرقم من 0 الى 4 كما موضح في الكود الكود: 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-Only_Number 2-Only_Ar 3-Only_En 4-OnlyText 0-Close All = No Selected Dim Selected_Tybe_Text_Box As Long '===================================( Only Copy this Dim name as sours type Msbox Only Dim MsG1 As String Dim MsG2 As String Dim MsG3 As String '****************************************( Selected Number From 0 To 4 ) Selected_Tybe_Text_Box = 1 '***************************************** On Error Resume Next If Selected_Tybe_Text_Box = 1 Then '================================( ارقام فقط Dim Chkstr As String Chkstr = "0123456789" If KeyAscii > 26 Then 'اي ان المفتاح الذي تم نقره ليس من ضمن المفاتيح التحكم مثل = Ctrl 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 End If End If If Selected_Tybe_Text_Box = 2 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 Selected_Tybe_Text_Box = 3 Then '================================( لغة انجليزية فقط 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 Selected_Tybe_Text_Box = 4 Then '================================( ادخال حروف فقط Select Case KeyAscii Case 48 To 57, 32 '(الغاء 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 End Sub 3- استكمال الواجهة الرئيسية لفتح التقارير والطباعة + فتح النماذج مع الفحص طبق الصلاحيات 4- اضافة تخصيص التقارير بصلاحيات لتحديد اجهزة الطباعة او التمكين طباعة افتراضية 5- تصحيح بعض الاكواد مثل تخصيص عدد مرات الطباعة ...+ بعض من التصحيحات واستكمال ========================================= الاستكمال قريبا تحميل المرفق https://www.mediafire.com/file/01gg2x7f3q3omvq/Update_17-2-2025_v3_User_Control_Open_App.rar/file

استاذ @Moosak❤️🌹❤️ نموذجين لكل نموذج فيه صوره عند نموذج 2 بدالة الشفاف اجعل شفاف بدرجة المناسبة والمفترض صوره اذا كان للصور كود الحفظ للنموذجين بتقارير حدث عند التحميل وعند التفصيل\حدث التنسيق عرض الصور بمسار واحد الى اسم ان يكون شفاف او صوره اما IF Then صوره 1 او 2 المهم استاذ @Moosak❤️🌹 يوجد في الورد ادراج \ نماذج ثلاثية الابعاد ممكن التوضيح وشكرا

=============================================( صور + مرفق + فيديو ) Update: 🌹 استاذ @Foksh ❤️🌹 لما انتهي منه اقدم شرح بيسط لطريقة الاستخدام بعض التعديلات مثل دالة موحده لكافة التقارير والنماذج بتحدد الصلاحيات للمستخدمين وتنسيق النافذه والادوات ممكن (تعديل على الدالة فقط) افضل من تعديل على كل النماذج والتقارير 😇 تم اضافة دالة للاخطاء وتبسيط الكود 😂 بالاخير دمج الداول بدالة Name_Function : User_Mod_Admin ----------------------------------------------- @Foksh ❤️🌹اسألك هل عندك اقتراحات او كود او دالة لو التعديل لاي جزء استكمال ☕ 1- استكمال بتعديل على ادوات انشاء القوائم للواجهة الرئيسية 2- تعديل عند الخطأ كود حيث يمكن زيادة عدد الحقول بجلب IP And .... ToEnd تعديل داخل دالة واحده لاي حدث للنماذج او التقارير كود كود: '-----------------------------------------------------------------------( Error_Finction) 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 3- نسيت عرض بتحديث امس اضافة تخصيص للتقارير عند قائمة 😇 Admin And Devloper \ InFo_Company ...+ بعض من التصحيحات واستكمال ========================================= الاستكمال قريبا تحميل المرفق https://www.mediafire.com/file/yx87dhkb8gderak/Update_16-2-2025_Add_v3_Into_4_User_Control_Open_App.rar/file

=============================================( صور + مرفق + فيديو ) Update: 🌹 استكمال ☕ 1- تعديل الدالة بجعل الاعدادة وتنسيق بدالة واحد للمستخدم لكافة التقارير ( حجم التقرير كامل الشاشة وليس متغير كحجم النماذج ) الدالة : Public Function ReportAllowed(ByVal strname As String) As String '(FrmName As String) As Boolean ' ===========! '===================================( Only Copy this Dim name as sours type Dim strMsg_Give_Nmae As Response Dim GiveMeError As Recordset 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 Dim User_Name As String Dim ID_Name As String User_Name = DLookup("[name_user]", "[Control_User]") ID_Name = DLookup("[IDDX]", "[Control_User]") 'IDDX '===========( Name_Report For Reprt Control User '==========================================(1)No use True Dim Name_X As String Name_X = ReportAllowed '==============================================(Chack frist) If IsNull(DLookup("[name_rep]", "[User_Report]", "[name_rep] ='" & strname & "' And [IDDX] =" & ID_Name & " ")) Then MsG2 = "Sand Massage !" MsG1 = "لم تهئة الادارة بصلاحيات " MsG3 = " الرجاء الاتصال على مركز المعلومات لتهيئة والصلاحيات خطأ 101" MyMsgBox (MsG3), (MsG2), (MsG1), msg_Exclamation, Btn_OK_Only, Arabic_Center ', True, 2.5 DoCmd.Close acReport, strname Exit Function End If '============================================================================( Open REport If DLookup("[Open_Rep]", "[User_Report]", "[name_rep] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = True Then 'DoCmd.OpenReport strname End If If DLookup("[Open_Rep]", "[User_Report]", "[name_rep] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = False Then MsG2 = "Sand Massage !" MsG1 = "تنبيه للمستخدم! رسالة ادارية راجع المسؤل المختص " MsG3 = "الا تملك صلاحية الدخول او ليس لك حق الدخول او تم حظرك من الدخول او تم منعك من الدخول " MyMsgBox (MsG3), (MsG2), (MsG1), msg_Exclamation, Btn_OK_Only, Arabic_Center ', True, 2.5 DoCmd.Close acReport, strname DoCmd.Close acForm, "background_set_M" DoCmd.Close acForm, "Menu5" DoCmd.Close acForm, "Menu18" Exit Function End If '============================================================================( Print into Button Or If Keybord If DLookup("[Print_rip]", "[User_Report]", "[name_rep] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = True Then 'DoCmd.OpenReport strname 'DoCmd.RunCommand acCmdPrint End If If DLookup("[Print_rip]", "[User_Report]", "[name_rep] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = False Then MsG2 = "Sand Massage !" MsG1 = "تنبيه للمستخدم! رسالة ادارية راجع المسؤل المختص " MsG3 = " تملك صلاحية طباعة التقرير او ليس لك حق بالطباعة او تم حظرك من الطباعة او تم منعك من الطباعة" MyMsgBox (MsG3), (MsG2), (MsG1), msg_Exclamation, Btn_OK_Only, Arabic_Center ', True, 2.5 Exit Function End If '**********************************************************( Editor Report Admin with Devloper 'If Form_Menu18.n = 1 Then 'change_font_M (Me.name) 'End If On Error Resume Next '=====================================( Imge Report! ) If DLookup("[Slected_Img_Or_Txt]", "[Pssword_admin]") = True Then Reports(strname).B.Visible = True Reports(strname).B.Picture = DLookup("[Rep_IMG_dawon]", "[Pssword_admin]") Reports(strname).C.Visible = False End If If DLookup("[Slected_Img_Or_Txt]", "[Pssword_admin]") = False Then Reports(strname).C.Visible = True Reports(strname).B.Visible = False End If If IsNull(DLookup("[Rep_IMG_2]", "[Pssword_admin]")) Then Reports(strname).A.Visible = False Else Reports(strname).A.Visible = True Reports(strname).A.Picture = DLookup("[Rep_IMG_2]", "[Pssword_admin]") End If '**********************************************************( Keybord ) ********************************************* '====================================================( Frist Chack Keybord If IsNull(DLookup("[Name_Form_Report]", "[Set_KeyBord_Report]", "[Name_Form_Report] ='" & strname & "'")) Then MsG2 = "Sand Massage !" MsG1 = "لم تهئة الادارة بصلاحيات " MsG3 = " الرجاء الاتصال على مركز المعلومات لتهيئة والصلاحيات خطأ 102" MyMsgBox (MsG3), (MsG2), (MsG1), msg_Exclamation, Btn_OK_Only, Arabic_Center ', True, 2.5 DoCmd.Close acReport, strname Exit Function End If '=====================================================( Set OFF Or On Set Keybord If DLookup("[Set_On_Keybord]", "[Set_KeyBord_Report]", "[Name_Form_Report] ='" & strname & "'") = True Then Reports(strname).KeyPreview = True Else Reports(strname).KeyPreview = False End If '******************************************( Set _ Icon Window _ Text ) ************************************ Dim dbs As DAO.Database Dim obj As Object Dim strTitle As String Dim s As String Dim intX As Integer Dim strDBIcon As String Dim strFormIcon As String Const DB_Text As Long = 10 Const conPropNotFoundError = 3270 '=========================( عنوان وايقون لقاعدة البيانات For db Name And Icon ) Set dbs = CurrentDb '=============================( Name ) strTitle = DLookup("[name_text]", "[DB_Icon_At_OPen]") dbs.Properties!AppTitle = strTitle '=====================( Icon ) strDBIcon = DLookup("[Icon_path]", "[DB_Icon_At_OPen]") s = DLookup("[Icon_path]", "[DB_Icon_At_OPen]") intX = AddAppProperty("AppIcon", DB_Text, s) Application.RefreshTitleBar '=========================( عنوان وايقونة للنموذج For Me.report.Name Name And Icon ) '===================(Icon ) strFormIcon = DLookup("[Icon_path]", "[Icon_bar_Repor]", "[name_Form]='" & strname & "'") SetFormIcon Reports(strname).hwnd, DLookup("[Icon_path]", "[Icon_bar_Repor]", "[name_Form]='" & strname & "'") '==========================( Name ) Reports(strname).Caption = DLookup("[name_text]", "[Icon_bar_Repor]", "[name_Form]='" & strname & "'") & " " & Date & " " 'DoCmd.Maximize '========================================( No Control cahng Size window Form and report And Click bar windows for chacng ) If DLookup("[No_Click_Chang_Size]", "[Icon_bar_Form]", "[name_Form]='" & strname & "'") = -1 Then Dim hMenu As Long Dim lStyle As Long 'disable MAXIMIZE button If DLookup("[Style_Nobar_For_disktop]", "[Icon_bar_Form]", "[name_Form]='" & strname & "'") = -1 Then Else lStyle = GetWindowLong(Reports(strname).hwnd, GWL_STYLE) End If lStyle = lStyle And Not WS_MAXIMIZEBOX Call SetWindowLong(Reports(strname).hwnd, GWL_STYLE, lStyle) End If '************************************( Set_Top_Left Chacng Size window ) ********************************* If DLookup("[Only_Full_Desktop]", "[Icon_bar_Repor]", "[name_Form]='" & strname & "'") = -1 Then Dim lngWH As Long, lngWL As Long, lngWT As Long, lngWW As Long ' With Reports(strname) DoCmd.Maximize ' lngWT = .WindowTop ' lngWL = .WindowLeft ' lngWH = .WindowHeight ' lngWW = .WindowWidth ' DoCmd.Restore ' DoCmd.OpenForm "xzx" ' Forms![xzx]![x1] = lngWL 'Forms![xzx]![x2] = lngWT 'Forms![xzx]![x3] = lngWW 'Forms![xzx]![x4] = lngWH 'Call .move(lngWL, lngWT, lngWW, lngWH) 'End With For j = 1 To DLookup("[Line_window]", "[DB_Icon_At_OPen]") '200 'round corners 'UISetRoundRect code in modCreateRoundCorners Reports(strname).UISetRoundRect_rpt_desktop Reports(strname), j, False DoEvents Next DoCmd.Maximize Else For j = 1 To DLookup("[Line_window]", "[DB_Icon_At_OPen]") '200 'round corners 'UISetRoundRect code in modCreateRoundCorners Reports(strname).UISetRoundRectx Reports(strname), j, False DoEvents Next DoCmd.Maximize End If '==================================( Set Image wallpaper back Report ) ****************************** If IsNull(Form_background_set_M.S_N) Or Form_background_set_M.S_N = "" Then Else Reports(strname).Picture = Form_background_set_M.S_N End If '-----------------------------------------------------------------------( For Error Code Only Copy And No Can use Function = Here Error :) X exit_Ops: Exit Function ops: If err.Number = 2465 Then DoCmd.Maximize Exit Function End If If err.Number = 2585 Then DoCmd.Maximize Exit Function End If If err.Number = conPropNotFoundError Then Set obj = dbs.CreateProperty("AppTitle", dbText, strTitle) dbs.Properties.Append obj End If Dim strMsg As String Dim Title As String Dim SubTitle As String ' MsgBox "Error Number : " & Err.Number & vbNewLine & "Error Description : " & Err.Description : strMsg = "Error Description : " & vbCrLf & err.Description : Title = "Error Massage !" : SubTitle = "Error Number: " & err.Number Dim Number_MX_Error As String '============( XLong '========================( Sand Error To Tablet Set GiveMeError = CurrentDb.OpenRecordset("Error_All_MSGBOX") GiveMeError.AddNew GiveMeError![Err_Number] = err.Number GiveMeError![Error_Description] = err.Description GiveMeError![User] = "Not Now _CommingSoon " GiveMeError![Pc] = Environ("username") GiveMeError![Today] = Date GiveMeError![ToTime] = Time() ' GiveMeError![name_Form] = Me.Form.name ' GiveMeError![Click_Button] = Me.ActiveControl.name & " -Name_Button: " & "تفعيل رسالة الخطأ عند الخطأ OnError" 'Me.Error.Caption GiveMeError.Update DoEvents 'Number_MX_Error = DMax("[ID]", "[Error_All_MSGBOX]") MyMsgBox strMsg, Title, SubTitle, msg_Critical, Btn_OK_Only, English_Left, False Resume exit_Ops Exit Function End Function كود الاستدعاء داخل التقرير حدث عند الفتح كود: Private Sub Report_Open(Cancel As Integer) '===========================( chack User '=============================( Only 2 Code Function For Chack User '=====================================( IF Form (1) 'Call FormsAllowed(Me.Form.name) '=====================================( IF Report (1) Call ReportAllowed(Me.Report.name) End Sub 2- استكمال وتصحيح عرض التقارير بزر الفتح 3- اضافة عرض التقارير بالواجهة الرئيسية بعد تسجيل الدخول ...+ بعض من التصحيحات واستكمال ========================================= الاستكمال قريبا تحميل المرفق https://www.mediafire.com/file/9rur7b2grpokxdu/Update_15-2-2025_Add_v3_Into_4_User_Control_Open_App.rar/file