مساعدة في تطوير نموذج يتحكم في صلاحيات المستخدمين

[بوعبد الله محفوظ]

السلام عليكم ورحمة الله تعالى وبركاته

لمراجعة بداية الموضوع يرجى زيارة هذه الصفحة

https://www.officena.net/ib/topic/79975-صلاحيات-المستخدمين/

في الموديل "Globals" قمت بالتعريفات التالية

Public VUserID As Integer 'من اجل حفظ رقم تعريف المستخدم
Public VFirstLast As String 'من أجل حفظ قيمة الاسم واللقب
Public VFirst As String 'من أجل حفظ قيمة الاسم
Public VLast As String 'من أجل حفظ قيمة اللقب 
Public VUserName As String 'من أجل حفظ اسم المستخدم

بعد ذلك أنشئت نموج جديد"AdminNaviForm"

حيث عند اختيار أي مستخدم والذهاب إلى الأذونات يتم عرض بيانات ذلك المستخدم مع الصلاحيات التي يمتلكها

وفي الحدث عند النقر في زر الأذونات وضعت الكود التالي

Private Sub NavigationButton9_Click()


[Forms]![AdminNaviForm]![AdminNavSubform]![txtID] = VUserID
[Forms]![AdminNaviForm]![AdminNavSubform]![txtFirstLast] = VFirstLast
[Forms]![AdminNaviForm]![AdminNavSubform]![txtUserName] = VUserName

[Forms]![AdminNaviForm]![AdminNavSubform]!chkOpenUser = DLookup("COpen", "tblHasAccess", "[UserID]= " & [Forms]![AdminNaviForm]![AdminNavSubform]![txtID])
[Forms]![AdminNaviForm]![AdminNavSubform]!chkCViewUser = DLookup("CView", "tblHasAccess", "[UserID]= " & [Forms]![AdminNaviForm]![AdminNavSubform]![txtID])
[Forms]![AdminNaviForm]![AdminNavSubform]!chkEditUser = DLookup("CEdit", "tblHasAccess", "[UserID]= " & [Forms]![AdminNaviForm]![AdminNavSubform]![txtID])
[Forms]![AdminNaviForm]![AdminNavSubform]!chkCdeleteUser = DLookup("Cdelete", "tblHasAccess", "[UserID]= " & [Forms]![AdminNaviForm]![AdminNavSubform]![txtID])
[Forms]![AdminNaviForm]![AdminNavSubform]!chkCAddUser = DLookup("CAdd", "tblHasAccess", "[UserID]= " & [Forms]![AdminNaviForm]![AdminNavSubform]![txtID])

End Sub

وفي نموذج المستخدمين وفي الحدث الحالي وضعت الكود التالي

Private Sub Form_Current()
On Error Resume Next
VUserID = Me.ManagementID
VFirst = Me.txtFirstName
VLast = Me.txtLastName
VFirstLast = VFirst & " " & VLast
VUserName = Me.txtUserName
End Sub

وعند الضغط على زر حفظ في نموذج الأذونات وضعت الكود التالي

Private Sub btnSave_Click()
msaved = True

Dim rs As Recordset
Dim criteria As String
Set rs = CurrentDb.OpenRecordset("tblHasAccess", dbOpenSnapshot, dbReadOnly)
criteria = "[UserID]=" & [txtID] _
& "And [FormName]='" & [txtfrmUser] & "'"
         
            
rs.FindFirst criteria

If rs.NoMatch = False Then

 CurrentDb.Execute "UPDATE tblHasAccess " _
        & "SET COpen = '" & [chkOpenUser] & " ' ,  CEdit = '" & [chkEditUser] & "'," _
        & "CView ='" & [chkCViewUser] & " ' ,Cdelete ='" & [chkCdeleteUser] & "'," _
        & "CAdd ='" & [chkCAddUser] & "'" _
        & "WHERE tblHasAccess.UserID =" & [txtID] _
        & "and tblHasAccess.FormName ='" & [txtfrmUser] & "' ;"
     

          
 Else
     CurrentDb.Execute " INSERT INTO tblHasAccess " _
        & "(UserID,FormName, COpen, CView, CEdit, Cdelete, CAdd) VALUES " _
         & "('" & [txtID] & "', '" & [txtfrmUser] & "','" & [chkOpenUser] & " ','" & [chkCViewUser] & "','" & [chkEditUser] & "','" & [chkCdeleteUser] & "','" & [chkCAddUser] & "');"
    'MsgBox "تم الحفظ بنجاح", vbMsgBoxRight + vbMsgBoxRtlReading, "رسالة تأكيد"
          End If



End Sub

هذا من أجل نموج واحد فقط و لو اتبعت هذا النمط فان الكود سيكون كبيرا جدا

هل من أفكار من أجل كود فعال وتجنب التكرار

رابط الملف على موقع الخليج

https://gulfsup.com/c5d091x 

آآآآآآآآآآآآآآآآآآآآسف على الإطالة

بارك الله فيكم وفي علمكم