د.كاف يار

تفضل هذا التعديل سيتم اغلاق النموذج او التقرير في حال عدم استيفاء شروط الدخول 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

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

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

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

الافضل تقسيم قاعدة البيانات و تحويل القاعدة الى SQL

تفضل التعديل att.accdb

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

استبدل الكود في حدث عند الفتح بالتالي On Error Resume Next If DCount("*", "UPDATES", "[Select]=False") <> 0 Then Call NewUPDATE Else Kill CurrentProject.Path & "\UpdateFile.cmd" End If

الواضح انك ما استخدمت التعديل التعديل يقوم بالمهمة التي تريدها

تفضل هذا التعديل 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

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

تفضل هذا التعديل و اضف الجداول التي تحتاجها 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, "تأكيد" حدد النماذج التي تحتاج الى تعديلها و التقارير و ستجدني انشاء الله في خدمتك

هذا الكود لا يتناسب السجلات المتعددة فقط للسجلات الفردية لكني تفضلي هذا الإسلوب في تخزين و ترحيل البيانات بين الجداول حيث تم انشاء نسخة مطابقة للجدول لحفظ البيانات المؤقته فيه و من ثم يتم ترحيلها للجدول الأساسي تفضلي التعديل test.zip