مساعدة بتحديث الادارات في الصلاحيات V3

[hanan_ms]

=============================================( صور + مرفق + فيديو )

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]

=============================================( صور + مرفق + فيديو )

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]

 

=============================================( صور + مرفق + فيديو )

Update: 🌹

 

استكمال ☕

                                                                     (( :اضافة بقائمة الاعدادة (( قوائمة الادخال

1- اخال الرقم المدني القومي 

2- ادخال المبالغ المالية

3- ادخال ارقام الهوات 

4- ادخال التواريخ الاجازات الرسمة للترصيد

- ملاحظة تم اضافة تجربة الاخال لكل القوائم المذكوره

************************

5- تطبيق على قائمة اضافة مستخدم جديد للصلاحيات 

بعض من التصحيحات واستكمال

=========================================

الاستكمال قريبا 

تحميل المرفق

https://www.mediafire.com/file/vzncllvgs933v79/Update_v3_Into_4_User_Control_Open_App.rar/file

[hanan_ms]

=============================================( صور + مرفق + فيديو )

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

[hanan_ms]

=============================================( صور + مرفق + فيديو )

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]

سؤال لحضرتك ،

لماذا لا تتوجه الى البساطة في تنفيذ أفكارك ؟؟؟؟؟؟؟

أعتقد أنه يوجد أشخاص تعجبهم فكرة معينة في عملك ، ولكن اتجاهك الى الغموض يشتت أفكار بعض الأشخاص للحصول على طلبهم .

كما أنه في طريقة شرحك يوجد نوع من عدم الوضوح 😁 .

حاول تبسيط الأمور في حروفك حتى يستفاد من طرحك وأفكارك 😇 .

 

[hanan_ms]

=============================================( صور + مرفق + فيديو )

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]

=============================================( صور + مرفق + فيديو )

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

تم تعديل الإثنين at 01:17 بواسطه hanan_ms

[hanan_ms]

=============================================( صور + مرفق + فيديو )

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

تم تعديل بالامس في 01:10 بواسطه hanan_ms