jjafferr

وبدون تعليق : http://www.pruittfamily.com/paul/MDE2MDB.htm http://www.everythingaccess.com/mdeconversion.asp جعفر

وعليكم السلام أخي أبو الآء الظاهر الحياة اخذتك بعيدا عن الاكسس جعفر

اخي شفان هل تستعمل الاكسس 2016؟ وهل عملت القفل على الاكسس 2016؟ جعفر

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

السلام عليكم أخي ابوجاسم ، اعتقد فيه عدم فهم للموضوع!! لما اباجودى قال: 1 و 2 لحل مشكلة ماقبل التحويل ، ولم يصل للنتقطة 3 بعد !! بالنسبة للنقاط 1 و 2 ، فانت تؤكد على عمل البرنامج بطريقة صحيحة: ولكن اباجودى لم يعمل النقطة رقم 3 بعد ، لذلك تقدر تعمل اللي قلت عنه لوسمحت اباجودى ، اكمل مشوار الخطوة 3 ، والتي ستكون قفل الشفت ، وتسليم المرفق بصيغة accde جعفر

حياك الله اخوي شفان وملاحظتك كانت في مكانها لهذا السبب ، انا اقول : انت وضعت مشاركتك قبل ان ترى ردي الاخير والذي وضعت فيه الكود ، والكود موجود فيه جعفر

اها ، لم التفت للشرط الاول اذن الاستعلام سيكون: . والكود سيصبح: Dim rst1 As DAO.Recordset Dim rst2 As DAO.Recordset Set rst1 = CurrentDb.OpenRecordset("Select * From tbl1") Set rst2 = CurrentDb.OpenRecordset("Select * From tbl2") rst1.MoveLast: rst1.MoveFirst RC1 = rst1.RecordCount For i = 1 To RC1 rst2.FindFirst "[degree]='" & rst1!degree & "' And [names]='" & rst1!fullnames & "'" If rst2.NoMatch = False Then rst2.Delete End If rst1.MoveNext Next i rst1.Close: Set rst1 = Nothing rst2.Close: Set rst2 = Nothing جعفر

وعليكم السلام اخي شفان الرابط بين الجدولين معناه ان Degree يجب ان تكون متساوية بين الجدولين ، فيعرض النتائج تلك فقط واليك طريقة اخرى بالكود ، وبنفس النتائج: Dim rst1 As DAO.Recordset Dim rst2 As DAO.Recordset Set rst1 = CurrentDb.OpenRecordset("Select * From tbl1") Set rst2 = CurrentDb.OpenRecordset("Select * From tbl2") rst1.MoveLast: rst1.MoveFirst RC1 = rst1.RecordCount For i = 1 To RC1 rst2.FindFirst "[degree]='" & rst1!degree & "'" If rst2.NoMatch = False Then rst2.Delete End If rst1.MoveNext Next i rst1.Close: Set rst1 = Nothing rst2.Close: Set rst2 = Nothing جعفر

وعليكم السلام تفضل جعفر

السلام عليكم ثلاثة من عمالقة الموقع تدخلوا في هذا الموضوع ، ولم يتم الوصول الى حل شو يا شباب ، الهمّه الهمّه يا شباب والا يعني تريدون الشباب الكبار (ما بقول الشياب) يتدخلون جعفر

وعليكم السلام أخي ابوجاسم ، ماشاءالله عليك انت في مشاركتك الـ 204 . لقد فتحت 4 مواضيع بمسميات مختلفة لنفس السؤال !!! لماذا ؟ انت تعرف انك تستطيع ان "تعدل" الموضوع (بما فيها اسم الموضوع ومكوناته) ، بعد وضعك الموضوع ، وقبل ان يضع احد رد عليك. وهذا الجزء من المنتدى ، منتدى الاكسس موجود لكي نتبادل الخبرات ، ونساعد بعض ، اما ان يساعدك احد على الخاص ، فالرجاء وضع مثل هذا الطلب في إعلانات شخصية للاعضاء بمقابل مادي بالاضافة الى انه عندك موضوع مفتوح نشط هنا: يُقفل. جعفر

وعليكم السلام الطريقة الصحيحة انك تعمله في النموذج ، هكذا جعفر

السلام عليكم الحمدلله في الكثير من الاحيان ، يحتاج صاحب السؤال الى الامساك بطرف الخيط ، ويُكمل المشوار ، وهذا ما حصل هنا انا توقفت لثلاثة اسباب: 1. وجود خبير محترف ومتخصص ، الاستاذ رمهان ، وفي انتظار مرفق فيه جميع ما توصل اليه ، 2. كنت على ثقة ان أخي أوس (وكم مرة ناديتك أنس وانت ساكت عني ، شكرا) سيستفيد من عمل الاستاذ رمهان وعملي وسيخطو للخطوة التالية ، 3. وكان يجب ان ابدأ من المرفق الاصل من اول وجديد ، للوصول الى مجموعة الشروط التي اعطانا إياها اخي أوس ، فلم تكن الفكرة في البداية تشتمل على كل هذه الشروط (حسب فهمي حينها) جعفر

السلام عليكم اخي كريمو يجب اولا ان نصل الى الحل الصحيح ، ومنها نعمل المعادله / المعادلات ، في المرفق ملف اكسل ، وفيه حساب يدوي لكل يوم من تاريخ التوظيف ، لموظفين اثنين ، رجاء التدقيق على العمل ، واذا كانت النتائج صحيحة ، فعليه ان شاء الله نقوم بترجمة الخطوات الى معادلات في الاكسس جعفر 600.xlsx.zip

وعليكم السلام مع تعديل أخي صالح ، استعمل الكود في الحدث "قبل التحديث" جعفر

تم حذف المرفق بناء على طلب صاحب الموضوع جعفر

موضوع المقارنه انتهينا منه ، وطبعا هناك الطريقة التي تفضلت انت بها ، ولكن المشكلة كانت في تطويع الكود ولف ذراعه لعمل اللي نريده والحمدلله تم ذلك جعفر

السلام عليكم هذه النسخة: ستفحص الجداول الخلفية في BE ، واذا كانت تختلف من عن جداول برنامج الواجهة FE (اذا اي من الجداول غير موجود ، او قيمة الرقم 12 غير موجود في جدول tblMonths) ، فسيخبرك بذلك ، وهذا هو الكود حاليا: Option Compare Database Option Explicit Function AreLinkedDBs() On Error GoTo MyErr Dim IsThereDBs As Long IsThereDBs = Nz(DCount("[DBID]", "BackDBs"), 0) If IsThereDBs = 0 Then DoCmd.OpenForm "LinkDBsMain" Exit Function End If Dim NoDBSCount As Long If IsThereDBs <> 0 Then CodeDb.Execute "UPDATE BackDBs SET BackDBs.[Found] = IIf(CheckFile(BackDBs.[DBPathANDName])=1,True,False);" NoDBSCount = Nz(DCount("[DBID]", "BackDBs", "[Found]=False"), 0) If NoDBSCount = 0 Then DoCmd.OpenForm "Background" Else: DoCmd.OpenForm "LinkDBsMain" Exit Function End If MyErr: If Err.Number <> 0 Then MsgBox Err.Number & " - " & Err.Description End If End Function Function AutoLink() On Error GoTo MyErr ' حذف الجداول المرتبطة الموجودة بقاعدة البيانات الامامية أي الحالية 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 <> "BackDBs" Then DoCmd.DeleteObject acTable, FrontObj.NAME End If Next FrontObj ' إعادة ربط الجداول مرة أخرى Dim MinDBID As Long, MaxDBID As Long, i As Long Dim BackObj As TableDef, BackDB As Database, BackFile As String, PW As String, PWD As String MinDBID = Nz(DMin("[DBID]", "BackDBs"), 0) MaxDBID = Nz(DMax("[DBID]", "BackDBs"), 0) For i = MinDBID To MaxDBID BackFile = Nz(DLookup("[DBPathANDName]", "BackDBs", "[DBID]=" & i), Null) PW = Nz(DLookup("[MyPass]", "BackDBs", "[DBID]=" & i), "") PWD = ";" & "PWD" & "=" & PW Set BackDB = DBEngine.Workspaces(0).OpenDatabase(BackFile, True, False, PWD) For Each BackObj In BackDB.TableDefs If left(BackObj.NAME, 4) <> "MSys" Then DoCmd.TransferDatabase acLink, "Microsoft Access", BackFile, acTable, BackObj.NAME, BackObj.NAME End If Next BackObj Next i Set FrontDB = Nothing Set BackDB = Nothing ' هنا ، نكتب اسم النموذج الخاص بالشاشة الافتتاحية ' اذا لم تكن ترغب في ان يتم فتح نموذج ما ، بعد عملية ربط الجداول ، امسح السطر التالي 'j DoCmd.OpenForm "Background" DoCmd.OpenForm "frm" MyErr: If Err.Number <> 0 Then MsgBox Err.Number & " - " & Err.Description End If End Function Function CheckFile(DBPath) As Integer ' هذه الدالة تقوم بالتأكد من وجود قاعدة البيانات الخلفية On Error GoTo MyErr: Open DBPath For Input As #1 Close CheckFile = 1 Exit Function MyErr: Exit Function End Function Function Compare_FE_BE_Tables(BackFile) On Error GoTo Err_Compare_FE_BE_Tables Dim stDocName As String Dim stLinkCriteria As String 'j DoCmd.Close 'j stDocName = "frm" 'j DoCmd.OpenForm stDocName, , , stLinkCriteria ' BackFile = GetOpenFile() If Len(BackFile & "") = 0 Or BackFile = 1 Then 'this is a start up test BackFile = DLookup("[DBPathANDName]", "BackDBs", "[DBID] = 3") Dim Start_Up As Integer Start_Up = 1 End If Dim FrontObj As AccessObject, FrontDB As Object Dim BackObj As TableDef, BackDB As Database, PW As String, PWD As String Set FrontDB = Application.CurrentData 'the Selected BE Set BackDB = DBEngine.Workspaces(0).OpenDatabase(BackFile, True, False, PWD) 'Start with a table to look for For Each FrontObj In FrontDB.AllTables If left(FrontObj.NAME, 4) <> "MSys" And FrontObj.NAME <> "BackDBs" Then ' FE = FrontObj.NAME 'look for that table in BE For Each BackObj In BackDB.TableDefs If left(BackObj.NAME, 4) <> "MSys" Then ' BE = BackObj.NAME If BackObj.NAME = FrontObj.NAME Then 'check if tblmonths contain the value 12 in Month_No If BackObj.NAME = "tblMonths" Then Dim dbsNew As Database Dim rst_TQ As DAO.Recordset Dim msg As Integer Set dbsNew = OpenDatabase(BackFile) Set rst_TQ = dbsNew.OpenRecordset("SELECT * FROM tblMonths IN '" & BackFile & "'") rst_TQ.FindFirst "[Month_No]=12" If rst_TQ.NoMatch Then 'MsgBox "Didn't find 12" msg = 1 Compare_FE_BE_Tables = 1 Else 'MsgBox "OK" Compare_FE_BE_Tables = 0 GoTo Found_It End If rst_TQ.Close: Set rst_TQ = Nothing: Set dbsNew = Nothing Else Compare_FE_BE_Tables = 0 GoTo Found_It End If ' Compare_FE_BE_Tables = 0 ' GoTo Found_It Else Compare_FE_BE_Tables = 1 End If End If 'BackObj Next BackObj If Compare_FE_BE_Tables = 1 Then GoTo Not_Same Found_It: End If 'FrontObj Next FrontObj 'All Good If Start_Up = 0 Then MsgBox "All FE tables exist in BE" Else DoCmd.OpenForm "Background" End If Set FrontDB = Nothing Set BackDB = Nothing 'update the field in the table 'DoCmd.SetWarnings False ' DoCmd.RunSQL ("UPDATE BackDBs SET DBPathANDName = " & BackFile & " WHERE DBID = 3") 'DoCmd.SetWarnings True 'link the tables 'Call AutoLink Exit Function Not_Same: 'No Good If msg = 0 Then MsgBox "The FE table : " & FrontObj.NAME & vbCrLf & _ "Is Not in the BE" Else MsgBox "Didn't find 12 in tblMonths" End If Set FrontDB = Nothing Set BackDB = Nothing If Start_Up = 1 Then DoCmd.OpenForm "LinkDBsMain" End If Exit_Compare_FE_BE_Tables: Exit Function Err_Compare_FE_BE_Tables: MsgBox Err.Description Resume Exit_Compare_FE_BE_Tables End Function جعفر 605.3.test.mdb.zip

هذا طلب غريب !! واشوف شو اللي اقدر عليه ان شاء الله جعفر

السلام عليكم استاذنا الفاضل رجاء تعمل نسخة من برنامجك ، وتحذف جميع الكائنات الأخرى اللي مالها علاقة بسؤالك ، وتبقي سجل واحد له علاقة في السؤال ، وارفقه. وإنشاءالله نساعدك في الجواب جعفر

غالي والطلب رخيص وهذا المرفق بعد ان يتأكد من وجود الجدول tblMonths ، يتأكد من وجود الشهر 12 ، بهذه الاضافة الى الكود: 'look for that table in BE For Each BackObj In BackDB.TableDefs If left(BackObj.NAME, 4) <> "MSys" Then ' BE = BackObj.NAME If BackObj.NAME = FrontObj.NAME Then 'check if tblmonths contain the value 12 in Month_No If BackObj.NAME = "tblMonths" Then Dim dbsNew As Database Dim rst_TQ As DAO.Recordset Dim msg As Integer Set dbsNew = OpenDatabase(BackFile) Set rst_TQ = dbsNew.OpenRecordset("SELECT * FROM tblMonths IN '" & BackFile & "'") rst_TQ.FindFirst "[Month_No]=12" If rst_TQ.NoMatch Then 'MsgBox "Didn't find 12" msg = 1 Compare_FE_BE_Tables = 1 Else 'MsgBox "OK" Compare_FE_BE_Tables = 0 GoTo Found_It End If rst_TQ.Close: Set rst_TQ = Nothing: Set dbsNew = Nothing Else Compare_FE_BE_Tables = 0 GoTo Found_It End If ' Compare_FE_BE_Tables = 0 ' GoTo Found_It Else Compare_FE_BE_Tables = 1 End If End If 'BackObj Next BackObj جعفر 605.2.test.mdb.zip

السلام عليكم 1. شكرا على الرد ، 2. لازلت في انتظار رؤية الكود ، او البرنامج جعفر

وعليكم السلام وبدون انزال المرفق ، وبدون تجربة الكود ، اليك طلبك ضع الكود في جميع نماذج وتقارير البرنامج ، حيث سيأخذ حقل الصور img ، سيأخذ الصورة (لم اقل مسار الصورة او معلوماتها ، وانما الصورة شخصيا ، وهذا اسرع من ان نطلب الصورة دائما من القرص الصلب) من الحقل img2 في النموذج الرئيسي frm_Main: me.img.picture=Forms!frm_Main!img2.picturedata جعقر

وعليكم السلام أخي أوس تفضل ، وهذا كود الوحدة النمطية Utils بالكامل ، بعد حذف الكود من النموذج ، وإضافة الكود فيها ، مع عمل التغييرات المطلوبة لعمل الكود: Option Compare Database Option Explicit Function AreLinkedDBs() On Error GoTo MyErr Dim IsThereDBs As Long IsThereDBs = Nz(DCount("[DBID]", "BackDBs"), 0) If IsThereDBs = 0 Then DoCmd.OpenForm "LinkDBsMain" Exit Function End If Dim NoDBSCount As Long If IsThereDBs <> 0 Then CodeDb.Execute "UPDATE BackDBs SET BackDBs.[Found] = IIf(CheckFile(BackDBs.[DBPathANDName])=1,True,False);" NoDBSCount = Nz(DCount("[DBID]", "BackDBs", "[Found]=False"), 0) If NoDBSCount = 0 Then DoCmd.OpenForm "Background" Else: DoCmd.OpenForm "LinkDBsMain" Exit Function End If MyErr: If Err.Number <> 0 Then MsgBox Err.Number & " - " & Err.Description End If End Function Function AutoLink() On Error GoTo MyErr ' حذف الجداول المرتبطة الموجودة بقاعدة البيانات الامامية أي الحالية 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 <> "BackDBs" Then DoCmd.DeleteObject acTable, FrontObj.NAME End If Next FrontObj ' إعادة ربط الجداول مرة أخرى Dim MinDBID As Long, MaxDBID As Long, i As Long Dim BackObj As TableDef, BackDB As Database, BackFile As String, PW As String, PWD As String MinDBID = Nz(DMin("[DBID]", "BackDBs"), 0) MaxDBID = Nz(DMax("[DBID]", "BackDBs"), 0) For i = MinDBID To MaxDBID BackFile = Nz(DLookup("[DBPathANDName]", "BackDBs", "[DBID]=" & i), Null) PW = Nz(DLookup("[MyPass]", "BackDBs", "[DBID]=" & i), "") PWD = ";" & "PWD" & "=" & PW Set BackDB = DBEngine.Workspaces(0).OpenDatabase(BackFile, True, False, PWD) For Each BackObj In BackDB.TableDefs If left(BackObj.NAME, 4) <> "MSys" Then DoCmd.TransferDatabase acLink, "Microsoft Access", BackFile, acTable, BackObj.NAME, BackObj.NAME End If Next BackObj Next i Set FrontDB = Nothing Set BackDB = Nothing ' هنا ، نكتب اسم النموذج الخاص بالشاشة الافتتاحية ' اذا لم تكن ترغب في ان يتم فتح نموذج ما ، بعد عملية ربط الجداول ، امسح السطر التالي 'j DoCmd.OpenForm "Background" DoCmd.OpenForm "frm" MyErr: If Err.Number <> 0 Then MsgBox Err.Number & " - " & Err.Description End If End Function Function CheckFile(DBPath) As Integer ' هذه الدالة تقوم بالتأكد من وجود قاعدة البيانات الخلفية On Error GoTo MyErr: Open DBPath For Input As #1 Close CheckFile = 1 Exit Function MyErr: Exit Function End Function Function Compare_FE_BE_Tables(BackFile) On Error GoTo Err_Compare_FE_BE_Tables Dim stDocName As String Dim stLinkCriteria As String 'j DoCmd.Close 'j stDocName = "frm" 'j DoCmd.OpenForm stDocName, , , stLinkCriteria ' BackFile = GetOpenFile() If Len(BackFile & "") = 0 Then Exit Function Dim FrontObj As AccessObject, FrontDB As Object Dim BackObj As TableDef, BackDB As Database, PW As String, PWD As String Set FrontDB = Application.CurrentData 'the Selected BE Set BackDB = DBEngine.Workspaces(0).OpenDatabase(BackFile, True, False, PWD) 'Start with a table to look for For Each FrontObj In FrontDB.AllTables If left(FrontObj.NAME, 4) <> "MSys" And FrontObj.NAME <> "BackDBs" Then ' FE = FrontObj.NAME 'look for that table in BE For Each BackObj In BackDB.TableDefs If left(BackObj.NAME, 4) <> "MSys" Then ' BE = BackObj.NAME If BackObj.NAME = FrontObj.NAME Then Compare_FE_BE_Tables = 0 GoTo Found_It Else Compare_FE_BE_Tables = 1 End If End If 'BackObj Next BackObj If Compare_FE_BE_Tables = 1 Then GoTo Not_Same Found_It: End If 'FrontObj Next FrontObj 'All Good MsgBox "All FE tables exist in BE" Set FrontDB = Nothing Set BackDB = Nothing 'update the field in the table 'DoCmd.SetWarnings False ' DoCmd.RunSQL ("UPDATE BackDBs SET DBPathANDName = " & BackFile & " WHERE DBID = 3") 'DoCmd.SetWarnings True 'link the tables 'Call AutoLink Exit Function Not_Same: 'No Good MsgBox "The FE table : " & FrontObj.NAME & vbCrLf & _ "Is Not in the BE" Set FrontDB = Nothing Set BackDB = Nothing Exit_Compare_FE_BE_Tables: Exit Function Err_Compare_FE_BE_Tables: MsgBox Err.Description Resume Exit_Compare_FE_BE_Tables End Function وطريقة العمل: عملت ماكرو بإسم AutoExec (اي انه اول شئ سوف يشتغل لما يفتح البرنامج) ، وفيه طلبت منه الذهاب الى Function AreLinkedDBs ، وطبعا حذفت النموذج Background من ان يفتح عند فتح البرنامج ها ، ما اسمع ، رجاء ترفع صوتك شوي اخوي رمهان علشان اسمعك عدل اخاف بعد ان نقوم بهذه العملية ، تطلع لنا وتطلب مقارنة اعدادات كل حقل جعفر 605.1.test.mdb.zip

السلام عليكم ومشاركة مع اخي رمهان ، اليك الكود الذي يقارن جداول FE مع جداول BE قاعدة البيانات التي تم اختيارها ، فاذا الجداول موجودة ، يخبرك بذلك ، ويربط الـ FE بالـ BE ، وإلا ، فسيخبرك ولن يفعل شئ: Option Compare Database Private Sub Command0_Click() On Error GoTo Err_Command0_Click Dim stDocName As String Dim stLinkCriteria As String 'j DoCmd.Close 'j stDocName = "frm" 'j DoCmd.OpenForm stDocName, , , stLinkCriteria BackFile = GetOpenFile() If Len(BackFile & "") = 0 Then Exit Sub Dim FrontObj As AccessObject, FrontDB As Object Dim BackObj As TableDef, BackDB As Database, PW As String, PWD As String Set FrontDB = Application.CurrentData 'the Selected BE Set BackDB = DBEngine.Workspaces(0).OpenDatabase(BackFile, True, False, PWD) 'Start with a table to look for For Each FrontObj In FrontDB.AllTables If left(FrontObj.NAME, 4) <> "MSys" And FrontObj.NAME <> "BackDBs" Then FE = FrontObj.NAME 'look for that table in BE For Each BackObj In BackDB.TableDefs If left(BackObj.NAME, 4) <> "MSys" Then BE = BackObj.NAME If BackObj.NAME = FrontObj.NAME Then Same = 0 GoTo Found_It Else Same = 1 End If End If 'BackObj Next BackObj If Same = 1 Then GoTo Not_Same Found_It: End If 'FrontObj Next FrontObj 'All Good MsgBox "All FE tables exist in BE" Set FrontDB = Nothing Set BackDB = Nothing 'link the tables Call AutoLink Exit Sub Not_Same: 'No Good MsgBox "The FE table : " & FrontObj.NAME & vbCrLf & _ "Is Not in the BE" Set FrontDB = Nothing Set BackDB = Nothing Exit_Command0_Click: Exit Sub Err_Command0_Click: MsgBox Err.Description Resume Exit_Command0_Click End Sub وعملت تغيير بسيط في الوحدة النمطية التي تقوم بالربط جعفر 605.test.mdb.zip