hanan_ms

: تحديث *على السريع * الي يحب تغير واجهة مشروعه 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

=============================================( صور + مرفق + فيديو ) Update: 🌹 استكمال ☕ 1- تصحيح الدالة الصلاحيات للنماذج والتقارير 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 = FormsAllowed '==============================================(Chack frist) If IsNull(DLookup("[name_frm]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ")) Then MsgBox " Opes back setting for Error Forget this form Open Or Now Awoch ", vbCritical, "Close Done " & Date DoCmd.Close acForm, strname Exit Function End If '============================================================================( Open Form If DLookup("[open_frm]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = True Then DoCmd.OpenForm strname End If If DLookup("[open_frm]", "[Usre_frm]", "[name_frm] ='" & 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 acForm, strname 'Exit Function End If '============================================================================( AllowAddition If DLookup("[add_new]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = True Then Forms(strname).AllowAdditions = True End If If DLookup("[add_new]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = False Then Forms(strname).AllowAdditions = False End If '============================================================================( AllowDeletion If DLookup("[delet]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = True Then Forms(strname).AllowDeletions = True End If If DLookup("[delet]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = False Then Forms(strname).AllowDeletions = False End If '============================================================================( AllowEdits If DLookup("[editor]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = True Then Forms(strname).AllowEdits = True End If If DLookup("[editor]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = True Then Forms(strname).AllowEdits = False End If 2- اضافة عرض التقارير + بتخصيص قائمة للمستخدمين 3- اضافة اختيار ايكون للتقارير مع العنوان بقائمة الادوات Admin 4- اضافة قائمة لتهيئة التقارير وعلامة المائية لحساب المطور ...+ بعض من التصحيحات واستكمال ========================================= الاستكمال قريبا تحميل المرفق https://www.mediafire.com/file/0nrnjkxipry23y6/Update_Fix_Add_v3_Into_4_User_Control_Open_App.rar/file

ان توفر الوقت اصحح واستكمل بتعديل الاكواد بنطاق جغرافي 2

=============================================( صور + مرفق + فيديو ) Update: 🌹 استكمال ☕ (( :اضافة بقائمة الاعدادة (( قوائمة الادخال 1- اخال الرقم المدني القومي 2- ادخال المبالغ المالية 3- ادخال ارقام الهوات 4- ادخال التواريخ الاجازات الرسمة للترصيد - ملاحظة تم اضافة تجربة الاخال لكل القوائم المذكوره ************************ 5- تطبيق على قائمة اضافة مستخدم جديد للصلاحيات بعض من التصحيحات واستكمال ========================================= الاستكمال قريبا تحميل المرفق https://www.mediafire.com/file/vzncllvgs933v79/Update_v3_Into_4_User_Control_Open_App.rar/file

=============================================( صور + مرفق + فيديو ) Update: 🌹 دايم طلباتي صعبة على العموم سكرة التهيئة بقائمة ادارة المستخدمين والصلاحيات @استبرق الموسوي ❤️🌹 استكمال ☕ 1- اضافة ادراج مستخدمين جدد 💯 - مع الفحص ولكل مستوى من مدير الى الموظف بالادارة بالقسم المحدد واذا كان مدير بادارته المحدد 2- اضافة تسجيل الكمبيوتر للمستخدم الجديد مع امكانية جعل المستخدم يتخدم اجهزة زملاءة التابعين للقسم فقط 3- خيارات التحكم تفعيل من قراءة فقط او القراء والكتابة او الاطلاع فقط على التقارير ... مع امكانية التعديل بقائمة الصلاحيات ========================================== 4 .. 5 QR- Barcod ( User ) : لتمكين تسجيل الدخول لتأمين اكثر عبر بطاقة يتم طباعتها للمستخدم قبل ادخال كلمة المرور واسم المستخدم -حسب رغبة العميل لتأمين دخول المستخدم ========================================== تصحيح استخدم كود عند الخطأ بالازرار بقائمة ادارة المستخدمين والصلاحيات بدل الدالة 😇 تحديث التالي فيديو للتوضيح في الاسفل تحميل المرفق https://www.mediafire.com/file/18o5da9o4mhtd6k/v3_Update_User_Control_Open_App.rar/file

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

نفترض مشروع اكسس متشعب :محاسبة قسم الميزانية والرواتب :ادارة قسم الحضور والغياب جعل النماذج والتقارير مجموعات قبل الصلاحيات لا يمكن اظهار صلاحيات المجموعات الاخرى فقط مجموعة قسم المستخدم فقط ( بيطبيعة العمل ================================================ اضافة تحكم بالصلاحيات للمسئول المباشر وتخصيص للمراقب والمدير عرض الكل

=============================================( صور + مرفق + فيديو ) Update: 🌹 < السابق > 1- شرح مبسط عن التثبيت + فك الضغط 2- شرح مبسط عن اضافة مستخدمين وتحكم بالصلاحية بداله << الجديد >> بعد انشاء نموذج او تقرير مباشر حدد تفعيل اختصارات الكيبورد فقط لكل نموذج او تقرير اللصق كود الحدث عند المفتاح للاسفل مع التأكد في نهائة الخصائص (مفتاح المعاينة ) = نعم الكود: Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) On Error Resume Next Dim f As String '============================================('طباعة الفورم او التقارير X If DLookup("[print_form]", "[Set_KeyBord]", "[Name_Form_Report] ='" & Me.Form.name & "'") = True Then If Shift = acCtrlMask And KeyCode = vbKeyP Then MsgBox " Not Allow Print Form And Sand Order Manger Cinter غير مسموح لك طباعة الشاشة ", vbExclamation, " Close Ctrl + P " & Date KeyCode = 0 End If End If '===========================================(بحث واستبدال X If DLookup("[Sarch_Fend_Change]", "[Set_KeyBord]", "[Name_Form_Report] ='" & Me.Form.name & "'") = True Then If Shift = acCtrlMask And KeyCode = vbKeyF Then KeyCode = 0 End If If KeyCode = vbKeyShift And vbKeyF4 Then KeyCode = 0 End If End If '===========================================(تراجع وتوسيط X If DLookup("[back and center]", "[Set_KeyBord]", "[Name_Form_Report] ='" & Me.Form.name & "'") = True Then If Shift = acCtrlMask And KeyCode = vbKeyF8 Then KeyCode = 0 End If End If If DLookup("[Escape]", "[Set_KeyBord]") = True Then If KeyCode = vbKeyEscape Then KeyCode = 0 End If End If '===========================================(تحديد الكل وحذف X If DLookup("[Selected All]", "[Set_KeyBord]", "[Name_Form_Report] ='" & Me.Form.name & "'") = True Then If Shift = acCtrlMask And KeyCode = vbKeyA Then KeyCode = 0 End If End If If KeyCode = vbKeyF2 Then KeyCode = 0 End If If DLookup("[Selected_Delete]", "[Set_KeyBord]", "[Name_Form_Report] ='" & Me.Form.name & "'") = True Then If KeyCode = vbKeyDelete Then KeyCode = 0 End If End If '===========================================(ادوات التحرير X If DLookup("[Cut]", "[Set_KeyBord]", "[Name_Form_Report] ='" & Me.Form.name & "'") = True Then If Shift = acCtrlMask And KeyCode = vbKeyX Then KeyCode = 0 End If End If If DLookup("[Copy]", "[Set_KeyBord]", "[Name_Form_Report] ='" & Me.Form.name & "'") = True Then If Shift = acCtrlMask And KeyCode = vbKeyC Then KeyCode = 0 End If End If If DLookup("[Past]", "[Set_KeyBord]", "[Name_Form_Report] ='" & Me.Form.name & "'") = True Then If Shift = acCtrlMask And KeyCode = vbKeyV Then KeyCode = 0 End If End If '===========================================(تحديد عامود وتحكم في الجدول المعروض X If DLookup("[Selected_dawon_tablet]", "[Set_KeyBord]", "[Name_Form_Report] ='" & Me.Form.name & "'") = True Then If Shift = acCtrlMask And KeyCode = vbKeyDown Then KeyCode = 0 End If End If '===========================================(اضافة بيانات وتحكم بتنقل الى جديد X If DLookup("[add_New_record]", "[Set_KeyBord]", "[Name_Form_Report] ='" & Me.Form.name & "'") = True Then If Shift = acCtrlMask And KeyCode = vbKeyTab Then KeyCode = 0 End If End If If DLookup("[tab]", "[Set_KeyBord]", "[Name_Form_Report] ='" & Me.Form.name & "'") = True Then If KeyCode = vbKeyShift And vbKeyTab Then KeyCode = 0 End If End If '==============================================( Enter ) If DLookup("[Enter]", "[Set_KeyBord]", "[Name_Form_Report] ='" & Me.Form.name & "'") = True Then If KeyCode = vbKeyReturn Then MsgBox "hello" End If End If Select Case KeyCode End Select End Sub تابع الفيديو للتوضيح اسفل الموضوع + تحميل المرفق ☕ =============================================( مرفق + فيديو ) v2_1_Control_User_With_Keybord_Auto(LognIN)_Ms_Access.rar

=============================================( صور + مرفق + فيديو ) Update: 🌹 بعد اذن الاستاذ @Moosak ❤️🌹☕ تغير الدالة مع الكود بمرفقك بالكامل يعمل مع اي تقرير او نموذج من غير كتابة اسمة بداله واحده فقط 😇 تلقائي Auto اسهل صلاحيات لكافة النماذج والتقارير والطباعة بدالة وحده اشر بالجدول بس يعني سو جدول وتقرير جديد اختر من الجدول صلاحيات مباشره شباب ؟! 😂 (حدث عند التحميل) كود الاستدعاء: '=============================( Only 2 Code Function For Chack User '=====================================( IF Form (1) Call FormsAllowed(Me.Form.name) '=====================================( IF Report (1) 'Call FormsAllowed(Me.Report.name) الدالة : Option Compare Database Option Explicit Public Function FormsAllowed(ByVal strname As String) As String '(FrmName As String) As Boolean ' ===========! Dim name_x As String name_x = FormsAllowed '==============================================(Chack frist) If IsNull(DLookup("[name_frm]", "[Control_User]", "[name_frm] ='" & strname & "'")) Then MsgBox " Opes back setting for Error Forget this form Open Or Now Awoch ", vbCritical, "Close Done " & Date DoCmd.Close acForm, strname Exit Function End If '============================================================================( Open Form If DLookup("[open_frm]", "[Control_User]", "[name_frm] ='" & strname & "'") = True Then DoCmd.OpenForm strname Else MsgBox "لا تملك صلاحية الدخول او ليس لك حق الدخول او تم حظرك من الدخول او تم منعك من الدخول ", vbExclamation, "رسالة ادارية راجع المسؤل المختص " & Date DoCmd.Close acForm, strname Exit Function End If '============================================================================( AllowAddition If DLookup("[add_new]", "[Control_User]", "[name_frm] ='" & strname & "'") = True Then Forms(strname).AllowAdditions = True Else Forms(strname).AllowAdditions = False End If '============================================================================( AllowDeletion If DLookup("[delet]", "[Control_User]", "[name_frm] ='" & strname & "'") = True Then Forms(strname).AllowDeletions = True Else Forms(strname).AllowDeletions = False End If '============================================================================( AllowEdits If DLookup("[editor]", "[Control_User]", "[name_frm] ='" & strname & "'") = True Then Forms(strname).AllowEdits = True Else Forms(strname).AllowEdits = False End If End Function Public Function Print_Allowed(ByVal strname As String) As String '==============================================(Chack frist) If IsNull(DLookup("[name_frm]", "[Control_User]", "[name_frm] ='" & strname & "'")) Then MsgBox " Opes back setting for Error Forget this form Open Or Now Awoch ", vbCritical, "Close Done " & Date DoCmd.Close acForm, strname Exit Function End If '============================================================================( Print into Button Or If Keybord If DLookup("[print]", "[Control_User]", "[name_frm] ='" & strname & "'") = True Then DoCmd.OpenReport strname DoCmd.RunCommand acCmdPrint Else MsgBox "لا تملك صلاحية طباعة التقرير او ليس لك حق بالطباعة او تم حظرك من الطباعة او تم منعك من الطباعة ", vbExclamation, "رسالة ادارية راجع المسؤل المختص " & Date Exit Function End If End Function @dd13901390🌹☕ 2- تعديل واستكمال بعض تابع الفيديو للتوضيح اسفل الموضوع + تحميل المرفق ☕ =============================================( مرفق + فيديو ) V2_One_FunctionLoginIN_Whit_Exprot_FileAuto_Ms_Access.rar

=============================================( صور + مرفق + فيديو ) Update: 🌹 @dd13901390🌹☕ قدمت لك طلبك وانا لم انتهي منه للتحكم بالحساب والصلاحيات 1- قائمة في نموذج تسجيل الدخول اذا كنت مطور او آدمن او مستخدم 2-تسجيل شركة او مؤسستك او قطاع عملك على البرنامج او نظامك مع اضافة اشعار والخلفية لنموذج تسجيل الدخول (مرونة بالتعديل على البيانات) 3- استايل بقائمة سفلية يمكن الاستفاده منها 4- انشاء حسابات وانشاء قائمة النماذج والتقارير للصلاحيات 5- تحكم بالصلاحيات والتحديث عند اختيار المستخدم 7- تحديث المسار الصور تلقائي عند الفتح + مرفق 6- طلبك عند فتح النموذج كود بسيط @dd13901390 ☕ '=====================( Err (1) And Exit (2) For On Error GoTo Look daown On Error GoTo Err_Ops '==============================================(Chack frist) If IsNull(DLookup("[name_frm]", "[Control_User]", "[name_frm] ='" & "QR" & "'")) Then MsgBox " Opes back setting for Error Forget this form Open Or Now Awoch ", vbCritical, "Close Done " & Date Exit Sub End If '========================================( Now Look Open Or No = Back User (Out) If DLookup("[open_frm]", "[Control_User]", "[name_frm] ='" & "QR" & "'") = True Then DoCmd.OpenForm "QR" Else MsgBox "لا تملك صلاحية الدخول او ليس لك حق الدخول او تم حظرك من الدخول او تم منعك من الدخول ", vbExclamation, "رسالة ادارية راجع المسؤل المختص " & Date Exit Sub End If '================================( name Err Exit (1) Exit_Ops: Exit Sub '================================( name At On Err 2 Err_Ops: MsgBox err.Description & err.number '========================================================( IF No Error Go Back Exit To (1) Resume Exit_Ops تابع الفيديو للتوضيح اسفل الموضوع + تحميل المرفق ☕ =============================================( مرفق + فيديو ) هذا هو طلب V1_LoginIN_Whit_Exprot_FileAuto_Ms_Access.rar

تعديل مرفق استاذ @kkhalifa1960☕ 1 - اصلاح تحجيم النموذج بعد عرض التقرير 2- فقط انسخ الكود وغير اسم التقرير 3- تعديل حجم النموذج بالعرض والارتفاع بنسخ رقم الحقلين ولصقهم باسفل الكود '=========================( الطابعة غير متوفره '=============================================( Only Copy Code And Chang Name Report Only Dim rptName As String Dim Name_Tablt As String Dim Fix_Size As Integer Name_Tablt = DLookup("[Size_paper]", "[Control_Print]") '====================================================( Frist Chack If IsNull(Name_Tablt) Or Name_Tablt = "" Then MsgBox " Slected itme Size paper (Isnull) ", vbCritical, "Close Done " Exit Sub End If If DCount("[Size_paper]", "[Control_Print]") = 0 Then MsgBox " لم تعين اعدادة للطباعة ", vbCritical, " Close Don " & Date Exit Sub End If On Error GoTo Awch: For Fix_Size = 1 To 1 rptName = "rapt" DoCmd.OpenReport rptName, acViewPreview With Reports(rptName).Printer On Error Resume Next '========================( No Size desin for print .PaperSize = acPRPS & Name_Tablt ' If p1 = -1 Then .Orientation = acPRORLandscape If p2 = -1 Then .Orientation = acPRORPortrait End With ' DoCmd.PrintOut ' DoCmd.Close acReport, rptName Next '===================================( Fix Size Form after Change Size report Me.Form.InsideHeight = 2190 Me.Form.InsideWidth = 5835 Exit Sub Awch: MsgBox Err.Description & Err.Number Exit Sub base_RP-1.rar

تفضل مرفق سابق لتغير الى A4 Code '========================= ( قديم لم يستكمل جرب المرفق Full Control Of Print Report التحكم في الطابعة وخصائصها طباعة التقارير.rar

=============================================( صور + مرفق + فيديو ) Update: 🌹 بعد اذن استاذي @ابو جودي ❤️🌹☕🌹 بعد اذن الاستاذ @Moosak ❤️🌹☕ بعد اذن الاستاذ @Amr Ashraf ❤️🌹 بعد اذن الاستاذ @Foksh 🌹❤️☕ هل من توصية او اقتراح بالتعديل والاضافة 1- تكامل الادخال البيانات بالجديد والحفظ الرجوع يمكن كده تلسمه للعميل 2- عند تحريك المؤشر تغير الحقول مع ليبل تغيره الى زر مع الضغط 3-4-5 .... (الكل من غير [ دوال ] الا الغاء زر الاغلاق وتمكينة (لا يتمكن المستخدم من ترك الاضافة الجديده او التعديل (الا بالحفظ او الرجوع ) ☕ على فكرة كود استاذ @Foksh جرب وغير تلاحظ الازرار لا تغير التمكين لا يعمل عند التنقل ما سويت سحر 😂 فرجعة على الكود سابق فشغال مع استكمال اذا كان جديد كود: On Error GoTo Ops Dim recordCount As String '========================== ( IF No Count Sum Or Change Only Number String 255 k recordCount = Nz(DCount("[Id]", "[Add_Custorm_QR]"), 0) '=========================( Not Number No Long Smoll and Long Long , Look for read db Link Acountes 1 To 20 Full Size , This Text If txtRec = recordCount Then Me.cmdLast.Enabled = False Me.cmdNext.Enabled = False Else Me.cmdLast.Enabled = True Me.cmdNext.Enabled = True End If If recordCount > txtRec Then Me.cmdPrevious.Enabled = True Me.cmdFirst.Enabled = True Me.cmdLast.Enabled = True Me.cmdNext.Enabled = True End If If recordCount = 0 Then Me.cmdPrevious.Enabled = False Me.cmdFirst.Enabled = False Me.cmdLast.Enabled = False Me.cmdNext.Enabled = False Me.cmDelete.Enabled = False Me.Save.Enabled = False Me.UndoR.Enabled = False Me.n.Enabled = False Me.x.Enabled = False Else Me.cmDelete.Enabled = True Me.n.Enabled = True Me.x.Enabled = True End If If txtRec = 1 Then Me.cmdPrevious.Enabled = False Me.cmdFirst.Enabled = False Else Me.cmdPrevious.Enabled = True Me.cmdFirst.Enabled = True End If If Me.Editor_date = -1 Then Me.PID.Enabled = True Me.PID.Locked = False Me.PName.Enabled = True Me.PName.Locked = False Me.PPhone.Enabled = True Me.PPhone.Locked = False Else Me.PID.Enabled = False Me.PID.Locked = True Me.PName.Enabled = False Me.PName.Locked = True Me.PPhone.Enabled = False Me.PPhone.Locked = True End If Exit Sub Ops: '=====================================( For New Record If IsNull(Me.txtRec) Or Me.txtRec = "" Then Exit Sub Else MsgBox "Error: " & Err.Description & " (" & Err.Number & ")", vbExclamation, " :: Error Chack Devloper :: " Exit Sub End If Contrl_Record_With_Qr__AppRunAuto_V-1-8 Add Folder_with _File_ SyS_ Ms_Access.rar

👍 بتأكيد افضل ومختصر ☕🌹❤️ شكرا + + + بخلص ورفع التحديث ومنتظره رايك

الملفات عندك بالتيرات مو داخل القاعده يستخدم للقراءة المستندات و المنتاجات والكرنيهات وهو صحيح الحذف تقريبا عند قرائة بالجهاز يستخرج رقم فقط ما تحتاج تحفظ صور الباركود ؟! لو كانت مستندات او فواتير ما تحذف صح يستخرج الرقم والاسم فقط كمرجع نحذف الصور الباركود عشان 98 ما يثقل ويفلش 😂 امزح جرب المرفق بعد اذن استاذ @Foksh☕❤️🌹