jjafferr

السلام عليكم اخي كريمو يجب اولا ان نصل الى الحل الصحيح ، ومنها نعمل المعادله / المعادلات ، في المرفق ملف اكسل ، وفيه حساب يدوي لكل يوم من تاريخ التوظيف ، لموظفين اثنين ، رجاء التدقيق على العمل ، واذا كانت النتائج صحيحة ، فعليه ان شاء الله نقوم بترجمة الخطوات الى معادلات في الاكسس جعفر 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

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

السلام عليكم هل عمل الكود؟؟ لم ارى ملاحظة ولا تعليق!! جعفر

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

وعليكم السلام واهلا وسهلا بك في المنتدى تستطيع ان تجعل ارتفاع الحقل كبير ، بحيث تحصل على 30 سجل فقط ، وعليك بالتجربة لتصل الى الارتفاع المطلوب جعفر

وعليكم السلام هذه بعض الاشياء التي يجب النظر فيها: يجب ان يكون البرنامج مقسما الى الجداول BE (وهذا الذي تضعه في الشبكة) ، والواجهة FE وفيه بقية الكائنات (ويكون على كمبيوترات المستخدمين) ، يجب ان تكون بعض الحقول مفهرسة في الجدول ، وهذه الحقول هي التي تستخدمها كمعيار في الاستعلام مثلا ، يجب ان تتأكد من الاستعلامات بالذات معمولة بطريقة لا تبطئ البرنامج والاكسس هنا يساعدك فيخبرك اين مكان المشكلة في برنامجك يجب ان تستخدم اسلاك بسرعة 1000 مثل cat 6 ، و Switch او Router بسرعة 1000 (Giga) . جعفر

وعليكم السلام توجد مجموعة حلول ، ولكن اهم مافي الموضع هو ما اشرت انت اليه ، وهو توقف البرنامج !! 1. ماذا تقصد بهذا؟ 2. في هذه الحالة لوسمحت ترفق لنا كود الحدث ، ورجاء ارفاق الكود من اول سطر جعفر

بالضبط ، يعني مثلا الى مجلد Employee_Pictures ، والذي موجود في مجلد قاعدة البيانات الخلفية ، كما في برنامج شئون الموظفين: Me.Pic.Picture = BE_Path & "\" & "Employee_Pictures\" & Me.Full_Name & ".jpg" او كما في برنامج المخازن ، حسب السنة ، واسم المستودع ، ثم ادخال او صرف ، ثم رقم الوصل Me.Scan.Picture = BE_Path & "\" & Me.Year & "\" & Me.Store_No & "\" & In_Type & "\" & Me.Reciept_No & ".jpg" ونعرف مكان وجود قاعدة البيانات ، سواء الخلفية او اذا لم تكن مقسمة ، من هذا الرابط: جعفر

رجاء ارفاق برنامجك للنظر في المشكلة جعفر

وعليكم السلام أخوي حربي لاحظت انك اضفت الشعبة في الجدول ، وبقية جداول الرواتب اخذوا القيمة ، وين المشكلة ، وايش المشكلة ، وبالتفصيل لوسمحت ابتداء باسم النموذج فاسماء الحقول ، وبالتفصيل لوسمحت جعفر

او بدون إدراج رابط ، بسطر من الكود فقط جعفر

هذه الروابط نتائج البحث عن OLE و جعفر

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

هذا معناه ان الكود لا يستطيع رؤية مسار التخزين في السيرفر ، فنصيحتي هي عمل مجلد داخل السيرفر ، ولنسمية Temp مثلا ، فيصبح مسار السيرفر: \\192.168.20.1\Temp\123.mdb . وللعلم ، فامر Xcopy هو: Xcopy "Source" "Destination" يعني في الكود حقك المصدر هو \\192.168.20.1\123.mdb ومكان التخزين هو C:\Users\" & Environ("Username") & "\Desktop\123.mdb" Call Shell("xcopy /y \\192.168.20.1\123.mdb C:\Users\" & Environ("Username") & "\Desktop\123.mdb", 1) . ان شاء الله ما تكون قالبهم جعفر