د.كاف يار

تفضل هذا التعديل

سيتم اغلاق النموذج او التقرير في حال عدم استيفاء شروط الدخول

If Me.AllowDeletions = False And _
    DCount("ID_User", "users", "deCode([UName],'User')='" & Trim(user) & "'") = 0 Then
    MsgBox " لا تملك الصلاحيات للدخول ", vbCritical + vbMsgBoxRight, "تنبيه"
    DoCmd.Close
    Exit Sub
End If

تفضل التعديل

cnbo.accdb

ضع هذا الكود في جميع النماذج و التقارير في حدث عند الفتح

If DCount("ID_User", "users", "deCode([UName],'User')='" & Trim(user) & "'") = 0 Or _
Me.AllowDeletions = False Then _
MsgBox " لا تملك صلاحيات لذلك ", vbCritical: Exit Sub

يجب ان يتحقق الشرط 

- وجود اسم مستخدم صحيح

- وجود صلاحية

اخي في ما سبق قمت بتكرار نفس السؤال

و اعطيتك الإجابة بأن الكود الذي لديك يقوم بنفس الوظيفة

يجب ان يكون سؤالك اكثر وضوع ماهي المشكلة التي تواجهك ؟

ماهي الطريقة الغير مشروعة التي اكتشفتها ؟

في رأي بأنه يوجد لديك كود قوي 

تفضل هذه المشاركة

مجلد جديد.rar

وهذي مشاركتي مع اخواني الأعزاء

المحزن.accdb

راجعي هذا الموضوع

الان, noor_99 said:

ايوا فصلت الجداول

اذا خليكي معايا خطوة بخطوة

اول خطوة راح تنشئ حساب في في سيرفر خارجي و يفضل في البداية ان يكون من السيرفرات المجانية لتجربة الخدمة قبل العمل

و انصحك بسيرفر SOMEE كما هو موضع في المشاركة اعلاه 

ممتاز

اذا نبدء اول خطوة في تهيئة البرنامج للعمل عن بعد

قبل البدء يجب فصل قاعدة البيانات عن الواجهات هل قمتي بهذه الخطوة فعلاً ؟

ماهو الهدف من نشر قاعدة البيانات على الانترنت ؟

ما الذي تنوي فعله ؟

الافضل تقسيم قاعدة البيانات 

و تحويل القاعدة الى SQL

تفضل التعديل

att.accdb

23 ساعات مضت, السبيل1 said:

تمام أستاذ @د.كاف يار 

وأعذرني لحداثة معلوماتي في مجالكم ولكن النقطة المهمة التي اود الوصول من خلال الصلاحية 

أنه إذا تم تجاوز نموذج الدخول بأي طريقة غير شرعية ألا تفتح النماذج التي لها صلاحية بل تعطي رسالة بأنه لا يجوز فتح هذا النموذج وهذا ما لم أجده إلا في المثال المرفق في أول مشاركة

 

الكود الحالي لديك يقوم بهذه الوظيفة فعلاًَ

استبدل الكود في حدث عند الفتح بالتالي

On Error Resume Next
If DCount("*", "UPDATES", "[Select]=False") <> 0 Then
    Call NewUPDATE
Else
    Kill CurrentProject.Path & "\UpdateFile.cmd"
End If

11 دقائق مضت, مصطفى الفيومى said:

هعمل استيراد لــ 3 جداول فقط عايز لما اعمل استيراد تاني من قاعدة بيانات اخري يوم بحذف الــ 3 جداول اللي انا عملتلهم استيراد قبل كده وليس جميع الجداول

 

الواضح انك ما استخدمت التعديل 

التعديل يقوم بالمهمة التي تريدها

تفضل هذا التعديل

On Error Resume Next
Dim strPath As String
strPath = Me.txtPath
Dim FrontObj As AccessObject, FrontDB As Object
Set FrontDB = Application.CurrentData
For Each FrontObj In FrontDB.AllTables
	If Left(FrontObj.Name, 4) <> "MSys" And FrontObj.Name <> "ccc" And FrontObj.Name <> "eee" Then
		DoCmd.DeleteObject acTable, FrontObj.Name
	End If
Next FrontObj

Dim BackObj As TableDef, BackDB As Database
Set BackDB = DBEngine.Workspaces(0).OpenDatabase(strPath, True, False)
For Each BackObj In BackDB.TableDefs
    If Left(BackObj.Name, 4) <> "MSys" And BackObj.Name <> "ccc" And BackObj.Name <> "eee" Then
        If BackObj.Name = "aaa" _
        Or BackObj.Name = "bbb" _
        Or BackObj.Name = "ccc" Then
            DoCmd.RunSQL "DROP TABLE [" & BackObj.Name & "]"
            DoCmd.TransferDatabase acImport, "Microsoft Access", strPath, acTable, BackObj.Name, BackObj.Name
        End If
    End If
Next BackObj

Set FrontDB = Nothing
Set BackDB = Nothing

29 دقائق مضت, السبيل1 said:

شكرا أستاذ @د.كاف يار علي المشاركة

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

ولكن ما أردته أن يكون إضافة مستخدم جديد متاحة دون الحاجة لأن يتم ذلك من خلال مدير

فهل ذلك ممكن 

 

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

بحيث كل مستخدم يدخل ينشئ حساب لنفسه و صفحة اخرى للمدير لإعتماد او الموافقة او تنشيط الحساب

هل هذا صحيح ؟

تفضل هذا التعديل و اضف الجداول التي تحتاجها

Dim strPath As String
strPath = Me.txtPath
Dim FrontObj As AccessObject, FrontDB As Object
Set FrontDB = Application.CurrentData
For Each FrontObj In FrontDB.AllTables
	If Left(FrontObj.Name, 4) <> "MSys" And FrontObj.Name <> "ccc" And FrontObj.Name <> "eee" Then
		DoCmd.DeleteObject acTable, FrontObj.Name
	End If
Next FrontObj

Dim BackObj As DAO.TableDef, BackDB As DAO.Database
Set BackDB = DBEngine.Workspaces(0).OpenDatabase(strPath, True, False)
For Each BackObj In BackDB.TableDefs
    If Left(BackObj.Name, 4) <> "MSys" And BackObj.Name <> "ccc" And BackObj.Name <> "eee" Then
        If BackObj.Name = "الجدول الأول" _
        Or BackObj.Name = "الجدول الثاني" _
        Or BackObj.Name = "الجدول الثالث" _
        Or BackObj.Name = "الجدول الرابع" Then
            DoCmd.TransferDatabase acImport, "Microsoft Access", strPath, acTable, BackObj.Name, BackObj.Name
        End If
    End If
Next BackObj

Set FrontDB = Nothing
Set BackDB = Nothing

ضع ازرار لضغط و اصلاح قاعدة البيانات

و ضع فيه الكود التالي

    Dim vbscrPath As String
    vbscrPath = CurrentProject.Path & "\CRHelper.vbs"
    If Dir(CurrentProject.Path & "\CRHelper.vbs") <> "" Then
        Kill CurrentProject.Path & "\CRHelper.vbs"
    End If
    Dim vbStr As String
    vbStr = "dbName = """ & CurrentProject.FullName & """" & vbCrLf & _
    "resumeFunction = ""ResumeBatch""" & vbCrLf & _
    "Set app = CreateObject(""Access.Application"")" & vbCrLf & _
    "Set dbe = app.DBEngine" & vbCrLf & _
    "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf & _
    "On Error Resume Next" & vbCrLf & _
    "Do" & vbCrLf & _
    "If Err.Number <> 0 Then Err.Clear" & vbCrLf & _
    "WScript.Sleep 500" & vbCrLf & _
    "dbe.CompactDatabase dbName, dbName & ""_1""" & vbCrLf & _
    "errCount = errCount + 1" & vbCrLf & _
    "Loop While err.Number <> 0 And errCount < 100" & vbCrLf & _
    "If errCount < 100 Then" & vbCrLf & _
    "objFSO.DeleteFile dbName" & vbCrLf & _
    "objFSO.MoveFile dbName & ""_1"", dbName" & vbCrLf & _
    "app.OpenCurrentDatabase dbName" & vbCrLf & _
    "app.UserControl = True" & vbCrLf & _
    "app.Run resumeFunction" & vbCrLf & _
    "End If" & vbCrLf & _
    "objFSO.DeleteFile Wscript.ScriptFullName" & vbCrLf
    Dim fileHandle As Long
    fileHandle = FreeFile
    Open vbscrPath For Output As #fileHandle
    Print #fileHandle, vbStr
    Close #fileHandle
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")
    wsh.Run """" & vbscrPath & """"
    Set wsh = Nothing
    Application.Quit

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

الأسباب

- الموضوع يحمل اكثر من سؤال

- محرر الأكواد مغلق برقم سري

النصيحة

- قسم فتح موضوع جديد لكل سؤال لكي تحصل الى الاجابة و يستطيع الاخوان مساعدتك

- قم بالغاء كلمة مرور الأكواد لكي لا تكون هنالك حاجة لكسرها ببرامج خارجية

- حدد اسم الجدول و النموذج و التقرير و الاستعلام الذي تريد تعديله يجب ان يكون طلبك واضح و مختصر

استبدل السطر كامل بالتالي

Dim BackObj As DAO.TableDef, BackDB As DAO.Database

تفضل هذا التعديل قد يفي بالغرض

Usrse.zip

تم انشاء نسخة مماثلة من الجدول المرتبط بالنموذج الفرعي

و تم ربط النسخة mainData_NonSave بالنموذج الفرعي

و تم انشاء استعلام الحاقي 

لكي يتم اخذ جميع السجلات من النسخة الجديدة و الحاقها بالجدول الرئيسي و افراغ الجدول بعد الإلحاق

If DCount("*", "mainData_NonSave") = 0 Then
    MsgBox "لا توجد بيانات لترحيلها", vbCritical + vbMsgBoxRight, "تنبيه"
Else
    If MsgBox("هل تريد حفظ البيانات و ترحيلها ؟", vbExclamation + vbYesNo + vbMsgBoxRight, "تأكيد الحفظ") = vbYes Then
            DoCmd.SetWarnings False
                    DoCmd.OpenQuery "AddNew_minData"  '================ تشغيل الاستعلام الإلحاقي ===============
                    DoCmd.RunSQL "DELETE FROM mainData_NonSave;"  '============== افراغ الجدول المؤقت من البيانات بعد تشغيل الاستعلام الالحاقي ==========
            DoCmd.SetWarnings True
        mainData.Requery
        MsgBox "تم حفظ البيانات و ترحيلها بنجاح", vbInformation + vbMsgBoxRight, "تأكيد"
    End If
End If

نعم تستطيع 

تفضل التعديل

s.zip

ابو الحسن حدد اين تريد الزيادة هل تقصد فقط في الجدول او النماذج

بعد الإطلاع على المرفق انصحك بأن تقوم بتغيير التكنييك في ما يخص الاستخدام 

فمثلا مثل هذا النموذج

التصميم غير منطقي فلو احتجت مستقبلا زيادة المخازن فبهذا النموذج لن تستطيع التقدم الا بتعديلات كبرى

يجب ان تقوم بالتفكير بطريقة عرض تخدمك مستقبلا

اما في ما يخص اضافة المخازن في جدول المخازن تفضل استخدم الحلقة التكرارية

Dim db As DAO.Database
Dim sSQL As String
Set db = CurrentDb

For i = 8 To 25
    sSQL = "INSERT INTO tbl_Stores (Auto_Date , iStore_Name) " & _
            " VALUES('" & Now & "', '" & "مخزن" & i & "')"
    db.Execute sSQL
Next
MsgBox "تم انشاء المخازن بنجاح", vbInformation + vbMsgBoxRight, "تأكيد"

حدد النماذج التي تحتاج الى تعديلها و التقارير و ستجدني انشاء الله في خدمتك

12 ساعات مضت, noor_99 said:

يعطيك العافية

بس ماضبط معاي الكود

Private Sub Form_BeforeUpdate(Cancel As Integer)
If MsgBox("DO you want save records? ", vbInformation + vbYesNo, "Save") = vbNo Then

       Me.Undo
       DoCmd.CancelEvent
   Else
   End If
End Sub

انا الكود الي حطيته قبل ضبط لكن مشكلة لما انتقل  من سجل الى سجل كل شوي يطلب حفظ

هذا الكود لا يتناسب السجلات المتعددة

فقط للسجلات الفردية

لكني تفضلي هذا الإسلوب في تخزين و ترحيل البيانات بين الجداول

حيث تم انشاء نسخة مطابقة للجدول لحفظ البيانات المؤقته فيه و من ثم يتم ترحيلها للجدول الأساسي

تفضلي التعديل

test.zip