hanan_ms قام بنشر يناير 31 قام بنشر يناير 31 =============================================( صور + مرفق + فيديو ) 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
hanan_ms قام بنشر فبراير 1 الكاتب قام بنشر فبراير 1 =============================================( صور + مرفق + فيديو ) Update: 🌹 دايم طلباتي صعبة على العموم سكرة التهيئة بقائمة ادارة المستخدمين والصلاحيات @استبرق الموسوي ❤️🌹 استكمال ☕ 1- اضافة ادراج مستخدمين جدد 💯 - مع الفحص ولكل مستوى من مدير الى الموظف بالادارة بالقسم المحدد واذا كان مدير بادارته المحدد 2- اضافة تسجيل الكمبيوتر للمستخدم الجديد مع امكانية جعل المستخدم يتخدم اجهزة زملاءة التابعين للقسم فقط 3- خيارات التحكم تفعيل من قراءة فقط او القراء والكتابة او الاطلاع فقط على التقارير ... مع امكانية التعديل بقائمة الصلاحيات ========================================== 4 .. 5 QR- Barcod ( User ) : لتمكين تسجيل الدخول لتأمين اكثر عبر بطاقة يتم طباعتها للمستخدم قبل ادخال كلمة المرور واسم المستخدم -حسب رغبة العميل لتأمين دخول المستخدم ========================================== تصحيح استخدم كود عند الخطأ بالازرار بقائمة ادارة المستخدمين والصلاحيات بدل الدالة 😇 تحديث التالي فيديو للتوضيح في الاسفل تحميل المرفق https://www.mediafire.com/file/18o5da9o4mhtd6k/v3_Update_User_Control_Open_App.rar/file
hanan_ms قام بنشر فبراير 8 الكاتب قام بنشر فبراير 8 =============================================( صور + مرفق + فيديو ) Update: 🌹 استكمال ☕ (( :اضافة بقائمة الاعدادة (( قوائمة الادخال 1- اخال الرقم المدني القومي 2- ادخال المبالغ المالية 3- ادخال ارقام الهوات 4- ادخال التواريخ الاجازات الرسمة للترصيد - ملاحظة تم اضافة تجربة الاخال لكل القوائم المذكوره ************************ 5- تطبيق على قائمة اضافة مستخدم جديد للصلاحيات بعض من التصحيحات واستكمال ========================================= الاستكمال قريبا تحميل المرفق https://www.mediafire.com/file/vzncllvgs933v79/Update_v3_Into_4_User_Control_Open_App.rar/file
hanan_ms قام بنشر فبراير 13 الكاتب قام بنشر فبراير 13 =============================================( صور + مرفق + فيديو ) 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 1
hanan_ms قام بنشر فبراير 15 الكاتب قام بنشر فبراير 15 =============================================( صور + مرفق + فيديو ) 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
Foksh قام بنشر فبراير 15 قام بنشر فبراير 15 سؤال لحضرتك ، لماذا لا تتوجه الى البساطة في تنفيذ أفكارك ؟؟؟؟؟؟؟ أعتقد أنه يوجد أشخاص تعجبهم فكرة معينة في عملك ، ولكن اتجاهك الى الغموض يشتت أفكار بعض الأشخاص للحصول على طلبهم . كما أنه في طريقة شرحك يوجد نوع من عدم الوضوح 😁 . حاول تبسيط الأمور في حروفك حتى يستفاد من طرحك وأفكارك 😇 . 1
hanan_ms قام بنشر فبراير 15 الكاتب قام بنشر فبراير 15 =============================================( صور + مرفق + فيديو ) Update: 🌹 13 hours ago, Foksh said: كما أنه في طريقة شرحك يوجد نوع من عدم الوضوح 😁 استاذ @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
hanan_ms قام بنشر فبراير 17 الكاتب قام بنشر فبراير 17 (معدل) =============================================( صور + مرفق + فيديو ) 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 تم تعديل فبراير 17 بواسطه hanan_ms
hanan_ms قام بنشر فبراير 21 الكاتب قام بنشر فبراير 21 (معدل) =============================================( صور + مرفق + فيديو ) 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 تم تعديل فبراير 21 بواسطه hanan_ms
hanan_ms قام بنشر فبراير 27 الكاتب قام بنشر فبراير 27 =============================================( صور + مرفق + فيديو ) 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
hanan_ms قام بنشر مارس 14 الكاتب قام بنشر مارس 14 =============================================( صور + مرفق + فيديو ) Update: 🌹 استكمال ☕ 1- اضافة قائمة ادخال للسكانر (ماسح الضوئي للمستندات) بنافذه واحده فقط -يعمل بتحديد اي جدول وحقل واحد فقط 2- اضافة فيديوات كان للشرح وتوضيح او محاضره 3- اضافة تسجيل الدخول للمستخدمين 4-تحسين واصلاح الاخطاء بتغير واختيار عرض واجهة الرئيسية 5- تعديل لعرض التقارير 6- اضافة اعدادة اكثر ...+ بعض من التصحيحات واستكمال ========================================= الاستكمال قريبا تحميل المرفق https://www.mediafire.com/file/2ye27loo61jum83/14-3-2025_UpDate_Sys_Object.rar/file
hanan_ms قام بنشر مارس 15 الكاتب قام بنشر مارس 15 =============================================( صور + مرفق + فيديو ) 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 * امكانية تغير النمط والاحتفاظ كثيم للواجهة الرئيسية فقط نسق الاوان في قائمة النوافذ غيرة من الوردي الى الازرق (( تابع الفيديو )) ..+ بعض من التصحيحات واستكمال ========================================= الاستكمال قريبا
hanan_ms قام بنشر مارس 18 الكاتب قام بنشر مارس 18 =============================================( صور + مرفق + فيديو ) 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 ========================================= الاستكمال قريبا
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.