اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

jjafferr

أوفيسنا
  • Posts

    9903
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    404

كل منشورات العضو jjafferr

  1. السلام عليكم استاذنا الفاضل رجاء تعمل نسخة من برنامجك ، وتحذف جميع الكائنات الأخرى اللي مالها علاقة بسؤالك ، وتبقي سجل واحد له علاقة في السؤال ، وارفقه. وإنشاءالله نساعدك في الجواب جعفر
  2. غالي والطلب رخيص وهذا المرفق بعد ان يتأكد من وجود الجدول 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
  3. السلام عليكم 1. شكرا على الرد ، 2. لازلت في انتظار رؤية الكود ، او البرنامج جعفر
  4. وعليكم السلام وبدون انزال المرفق ، وبدون تجربة الكود ، اليك طلبك ضع الكود في جميع نماذج وتقارير البرنامج ، حيث سيأخذ حقل الصور img ، سيأخذ الصورة (لم اقل مسار الصورة او معلوماتها ، وانما الصورة شخصيا ، وهذا اسرع من ان نطلب الصورة دائما من القرص الصلب) من الحقل img2 في النموذج الرئيسي frm_Main: me.img.picture=Forms!frm_Main!img2.picturedata جعقر
  5. وعليكم السلام أخي أوس تفضل ، وهذا كود الوحدة النمطية 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
  6. السلام عليكم ومشاركة مع اخي رمهان ، اليك الكود الذي يقارن جداول 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
  7. السلام عليكم ومشاركة مع اخي شفان ان احب استخدام استعلام الحاقي في مثل هذه الحالات ، فاعمل 3 استعلامات ، استعلام لكل مشرف (لأن كل مشرف عنده جدوله الخاص) ، وفي حدث بعد التحديث لمربع تحرير وسرد اختيار المشرف ، اعمل كود شبيه بهذا: 1. تأكد ان هذه البيانات غير موجودة في الجدول ، 2. استعمل استعلام الالحاق جعفر
  8. السلام عليكم هل عمل الكود؟؟ لم ارى ملاحظة ولا تعليق!! جعفر
  9. السلام عليكم هذه الطريقة غير صحيحة ، خصوصا ان جميع حقول الجداول سنويا ستكون نفسها ، لذا ، اعمل حقل السنة في الجدول ، ادخل جميع السنوات في الجدول ، كل سنة ببياناتها جعفر
  10. وعليكم السلام واهلا وسهلا بك في المنتدى تستطيع ان تجعل ارتفاع الحقل كبير ، بحيث تحصل على 30 سجل فقط ، وعليك بالتجربة لتصل الى الارتفاع المطلوب جعفر
  11. وعليكم السلام هذه بعض الاشياء التي يجب النظر فيها: يجب ان يكون البرنامج مقسما الى الجداول BE (وهذا الذي تضعه في الشبكة) ، والواجهة FE وفيه بقية الكائنات (ويكون على كمبيوترات المستخدمين) ، يجب ان تكون بعض الحقول مفهرسة في الجدول ، وهذه الحقول هي التي تستخدمها كمعيار في الاستعلام مثلا ، يجب ان تتأكد من الاستعلامات بالذات معمولة بطريقة لا تبطئ البرنامج والاكسس هنا يساعدك فيخبرك اين مكان المشكلة في برنامجك يجب ان تستخدم اسلاك بسرعة 1000 مثل cat 6 ، و Switch او Router بسرعة 1000 (Giga) . جعفر
  12. وعليكم السلام توجد مجموعة حلول ، ولكن اهم مافي الموضع هو ما اشرت انت اليه ، وهو توقف البرنامج !! 1. ماذا تقصد بهذا؟ 2. في هذه الحالة لوسمحت ترفق لنا كود الحدث ، ورجاء ارفاق الكود من اول سطر جعفر
  13. بالضبط ، يعني مثلا الى مجلد 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" ونعرف مكان وجود قاعدة البيانات ، سواء الخلفية او اذا لم تكن مقسمة ، من هذا الرابط: جعفر
  14. وعليكم السلام أخوي حربي لاحظت انك اضفت الشعبة في الجدول ، وبقية جداول الرواتب اخذوا القيمة ، وين المشكلة ، وايش المشكلة ، وبالتفصيل لوسمحت ابتداء باسم النموذج فاسماء الحقول ، وبالتفصيل لوسمحت جعفر
  15. هذه الروابط نتائج البحث عن OLE و جعفر
  16. اخي ابحث في منتدى الاكسس عن كلمة OLE ، وسترى العديد من المواضيع ، وهذا له علاقة بتغير إعدادات لغة الكمبيوتر الذي تم عمل البرنامج عليه ، عن اعدادات الكمبيوتر الذي تظهر له المشكلة جعفر
  17. هذا معناه ان الكود لا يستطيع رؤية مسار التخزين في السيرفر ، فنصيحتي هي عمل مجلد داخل السيرفر ، ولنسمية 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) . ان شاء الله ما تكون قالبهم جعفر
  18. نعم ، واخبرتك كيف ، واختر الطريقة المناسبة من الروابط في مشاركتي السابقة جعفر
  19. وعليكم السلام انا عملت مثالين ، والاثنين كما هو طلبك ، ولكن عليك الغوص للحصول على الكود ، وولكن بدون التقرير: و جعفر
  20. اخي محمد ابوخليل عمل تعديلات على النسخة الثامنة اللي تستعملها انت ، ووصل للنسخة 17 اللي ارفقها في مشاركته الاخيرة ، وهي تتفق مع جميع النتائج اللي توصلت لها انا ، فالافضل لك استعمال النسخة الاخيرة اللي انا وضعتها او اللي وضعها اخوي ابوخليل ، واتكل على الله جعفر
  21. تمام ، اذن نتائجنا متفقة الحمدلله جعفر
×
×
  • اضف...

Important Information