jjafferr

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

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

حياك الله

عفوا الموضوع يحتاج توضيح شوي اكثر انا لما شفت كود الحفظ ، قلت: فالسؤال هو: هل البرنامج كله يعمل بطريقة الكود ، او ان هناك ربط لجداول قاعدة البيانات الخلفية ، يعني جداول قاعدة البيانات الخلفية مربوطة بالبرنامج الامامي؟ فإذا الجداول مربوطة ، فكل الكلام اعلاه لا ينطبق عليك ، وانسى هذه الفقرة اما اذا كان برنامجك كله بالكود ولا يوجد عندك ربط مع جداول البيانات الخلفية ، فتستطيع فتح نموذج واحد فقط ، مثل نموذج بدء التشغيل والمتصل بجدول في القاعده اللي على السيرفر ، وتقدر تخليه ظاهر او مخفي ، ولكن لا تغلقه إلا عند إغلاق البرنامج اذا كان هذا الكمبيوتر حقيقةً سيرفر ، فالمفروض يكون فيه شيء بإسم Raid ، اي مجموعة هاردسكات تعمل مع بعض كهارددسك واحد ، وبالتالي كُله تمام اما اذا كان كمبيوتر عادي فيه هارددسك واحد ، ولكن منصب عليه Windows Server ، فهذا لا هو سيرفر ، ونعم تحتاج الى هارددسك اضافي لبرنامجك ولكني شبه متأكد بأن الضغط والاصلاح راح يحل المشكلة ان شاء الله ، وبإنتظار البشارة منك جعفر

تفضل ضع بياناتك التي في ملف الاكسل في الجدول: M1_BKAWEST_Original ثم افتح النموذج Form1 ، وانقر على الزر Fix imported Excel وسترى النتيجة في الجدول: M1_BKAWEST وهذا هو الكود الذي يقوم بالعمل: Private Sub cmd_Fix_Click() On Error GoTo err_cmd_Fix_Click Dim rstS As DAO.Recordset Dim rstD As DAO.Recordset Set rstS = CurrentDb.OpenRecordset("Select * From M1_BKAWEST_Original") Set rstD = CurrentDb.OpenRecordset("Select * From M1_BKAWEST") rstS.MoveLast: rstS.MoveFirst RCs = rstS.RecordCount For i = 1 To RCs If rstS!Field1 = "محافظة" Then rstS.MoveNext Field8 = rstS!Field1 Field9 = rstS!Field2 Field10 = rstS!Field3 Field11 = rstS!Field4 Field12 = rstS!Field5 rstS.MoveNext rstS.MoveNext End If rstD.AddNew rstD![الشهرة] = Replace(rstS!Field1, Chr(34), "") rstD![الاسم] = Replace(rstS!Field2, Chr(34), "") rstD![اسم الاب] = Replace(rstS!Field3, Chr(34), "") rstD![اسم الام] = Replace(rstS!Field4, Chr(34), "") rstD![تاريخ الولادة] = Replace(rstS!Field5, Chr(34), "") rstD![رقم السجل] = Replace(rstS!Field6, Chr(34), "") rstD![المذهب] = Replace(rstS!Field7, Chr(34), "") rstD![محافظة] = Replace(Field8, Chr(34), "") rstD![قضاء] = Replace(Field9, Chr(34), "") rstD![البلدة او الحي] = Replace(Field10, Chr(34), "") rstD![طائفة اللائحة] = Replace(Field11, Chr(34), "") rstD![الجنس] = Replace(Field12, Chr(34), "") rstD.Update rstS.MoveNext Next i Exit_cmd_Fix_Click: rstS.Close: Set rstS = Nothing rstD.Close: Set rstD = Nothing MsgBox "Done" Exit Sub err_cmd_Fix_Click: If Err.Number = 3021 Then Resume Exit_cmd_Fix_Click ElseIf Err.Number = 94 Then Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر 691.tarek.accdb.zip

حياك الله

تفضل 688.1.لازام نطوره - Copy.mdb.zip

تم تعديل زري البحث في مرفقي الاخير

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

لا ، ولهذا السبب اعطاك اخي شفان جواب على الطاير جعفر

تفضل وهذا الكود الاول Private Sub أمر20_Click() On Error GoTo error_Capture تابع15.Requery Dim rst As DAO.Recordset 'إيرادات iField = "إيرادات" mySQL = "Select [رقم السند]" mySQL = mySQL & " From السندات" mySQL = mySQL & " Where [نوع السند]='إيرادات'" mySQL = mySQL & " And التاريخ>=#" & Me.n1 & "#" mySQL = mySQL & " And التاريخ<=#" & Me.n2 & "#" mySQL = mySQL & " Order By [رقم السند]" Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst rc = rst.RecordCount Me.Erad_From = rst![رقم السند] rst.MoveLast Me.Erad_To = rst![رقم السند] 'اجل iField = "اجل" mySQL = "Select [رقم السند]" mySQL = mySQL & " From السندات" mySQL = mySQL & " Where [نوع السند]='اجل'" mySQL = mySQL & " And التاريخ>=#" & Me.n1 & "#" mySQL = mySQL & " And التاريخ<=#" & Me.n2 & "#" mySQL = mySQL & " Order By [رقم السند]" Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst rc = rst.RecordCount Me.Aajel_From = rst![رقم السند] rst.MoveLast Me.Aajel_To = rst![رقم السند] 'مصاريف iField = "مصاريف" mySQL = "Select [رقم السند]" mySQL = mySQL & " From السندات" mySQL = mySQL & " Where [نوع السند]='مصاريف'" mySQL = mySQL & " And التاريخ>=#" & Me.n1 & "#" mySQL = mySQL & " And التاريخ<=#" & Me.n2 & "#" mySQL = mySQL & " Order By [رقم السند]" Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst rc = rst.RecordCount Me.Masareef_From = rst![رقم السند] rst.MoveLast Me.Masareef_To = rst![رقم السند] 'سداد iField = "سداد" mySQL = "Select [رقم السند]" mySQL = mySQL & " From السندات" mySQL = mySQL & " Where [نوع السند]='سداد'" mySQL = mySQL & " And التاريخ>=#" & Me.n1 & "#" mySQL = mySQL & " And التاريخ<=#" & Me.n2 & "#" mySQL = mySQL & " Order By [رقم السند]" Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst rc = rst.RecordCount Me.Sadad_From = rst![رقم السند] rst.MoveLast Me.Sadad_To = rst![رقم السند] MsgBox "لا توجد سندات من نوع" & vbCrLf & msg Exit_error_Capture: rst.close: Set rst = Nothing Exit Sub error_Capture: If Err.Number = 3021 Then If InStr(msg, iField) = 0 Then msg = msg & iField & vbCrLf End If Resume Next ElseIf Err.Number = -2147352567 Then If InStr(msg, iField) = 0 Then msg = msg & iField & vbCrLf End If Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description Resume Exit_error_Capture End If End Sub وهذا كود قراءة النموذج الفرعي Private Sub cmd_Search2_Click() On Error GoTo error_Capture2 تابع15.Requery Dim rst As DAO.Recordset Dim rst2 As DAO.Recordset Set rst = Me.تابع15.Form.RecordsetClone 'إيرادات iField = "إيرادات" rst.Filter = "[نوع السند]='إيرادات'" rst.Sort = "[رقم السند]" Set rst2 = rst.OpenRecordset Me.Erad_From = rst2![رقم السند] rst2.MoveLast Me.Erad_To = rst2![رقم السند] 'اجل iField = "اجل" rst.Filter = "[نوع السند]='اجل'" rst.Sort = "[رقم السند]" Set rst2 = rst.OpenRecordset Me.Aajel_From = rst2![رقم السند] rst2.MoveLast Me.Aajel_To = rst2![رقم السند] 'مصاريف iField = "مصاريف" rst.Filter = "[نوع السند]='مصاريف'" rst.Sort = "[رقم السند]" Set rst2 = rst.OpenRecordset Me.Masareef_From = rst2![رقم السند] rst2.MoveLast Me.Masareef_To = rst2![رقم السند] 'سداد iField = "سداد" rst.Filter = "[نوع السند]='سداد'" rst.Sort = "[رقم السند]" Set rst2 = rst.OpenRecordset Me.Sadad_From = rst2![رقم السند] rst2.MoveLast Me.Sadad_To = rst2![رقم السند] MsgBox "لا توجد سندات من نوع" & vbCrLf & msg Exit_error_Capture2: rst.close: Set rst = Nothing rst2.close: Set rst2 = Nothing Exit Sub error_Capture2: If Err.Number = 3021 Then If InStr(msg, iField) = 0 Then msg = msg & iField & vbCrLf End If Resume Next ElseIf Err.Number = -2147352567 Then If InStr(msg, iField) = 0 Then msg = msg & iField & vbCrLf End If Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description Resume Exit_error_Capture2 End If End Sub جعفر 688.1.لازام نطوره - Copy.mdb.zip

حياك الله اخوي عبدالله ممكن حل المشكلة بالطريقة التي ذكرتها ، ولكنها ستكون جامدة ، ومحتاجة الى مبرمج لتغييرها وقت الحاجة الطريقة التي اخبرتك عنها هي الطريقة المتبعة والتي ينصح بإستعمالها المحترفين ، والتي استعملها في جميع برامجي ، ومن السهل ان تضيف او تغير او تحذف اي من البيانات فيها وطبعا نحن نعرف انه ليست كل الخيارات في الاكسس هي خيرات جيدة للبرنامج ، فمنها Lookup الجداول ، والصور المضمنة ، و Autocorrect Text ، ووو لذا يجب ان نكون حذرين منها جعفر

هل استعملت زر البحث2

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

انت لا تزال تطلب الترقيم 1 2 3 4 .... وبدون السنه ، وهذا ما اعطيتك في مرفقي الاخير ، فهل جربته؟

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

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

تفضل 691.tarek.accdb.zip

وعليكم السلام للأسف ما اتوصلت لعمل اللي تريده وبحثت في الانترنت كذلك ، ولم القى شيء كذلك الطريقة الوحيدة هي عمل جدول خاص للقائمة ، وبالتالي يمكنك استعمال Lookup في الجدول ، ولكن للعلم ، فاستخدام Lookup في الجداول غير مُحبّذ ، وبه عدة مشاكل ، وانت صادفت احد هذه المشاكل ، والطريقة الصحيحة هي عمل جدول خاص للقائمة ، وتستعمل القائمة في النموذج فقط. جعفر 689.Database1.accdb.zip

اعمل زر في النموذج ، وعلى حدث الزر ضع الكود ، ولكن يجب ان تعرف ان الاكسل قبل 2007 يعني اللي بصيغة xls يستوعب حوالي 65,536 سجل فقط جعفر

وعليكم السلام في اكثر من طريقة ، ولكن اليك الاسهل: expression.TransferSpreadsheet(TransferType, SpreadsheetType, Table/ Query Name, FileName, HasFieldNames, Range, UseOA) واستعمالها DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Employees", "C:\Temp\Newemps.xls", True او expression.OutputTo(ObjectType, Table/ Query Name, OutputFormat, OutputFile, AutoStart, TemplateFile, Encoding, OutputQuality) واستعمالها DoCmd.OutputTo acOutputTable, "Employees", acFormatXLS, "C:\Temp\Newemps.xls", True او جعفر

السلام عليكم موضوع التحديث كبير وفيه عدة نقاط والتي يجب النظر فيها ، مثلا: 1. تحديث FE فقط ، 2. تحديث FE ، وعمل تغيير على الجداول. خلينا في النقطة الاصعب والاهم ، وهي انزال النسخة الاحدث من الموقع كنتم 3 محترفين في عمل هذا الموضوع ، وانت قررت ان الخطوة التالية "معقدة بعض الشيء بالنسبة" فأرجو من اخي @Shivan Rekany و اخي @أبو عبدالله الحلوانى ان يتطوعوا لهذا العمل (او يعتذروا) ، وإلا فأنا مستعد ان شاء الله جعفر

السلام عليكم شكرا أخوي ابو خليل ، فانت شجعتني ان اقوم بأخذ البيانات من النموذج الفرعي ، بدل زيارة الجدول ، وهذه ستكون اسرع الطرق عملت زر جديد ، ووضعت عليه هذا الكود: Private Sub cmd_Search2_Click() On Error GoTo error_Capture2 تابع15.Requery Dim rst As DAO.Recordset Dim rst2 As DAO.Recordset Set rst = Me.تابع15.Form.RecordsetClone 'إيرادات rst.Filter = "[نوع السند]='إيرادات'" rst.Sort = "[رقم السند]" Set rst2 = rst.OpenRecordset Me.Erad_From = rst2![رقم السند] rst2.MoveLast Me.Erad_To = rst2![رقم السند] 'اجل rst.Filter = "[نوع السند]='اجل'" rst.Sort = "[رقم السند]" Set rst2 = rst.OpenRecordset Me.Aajel_From = rst2![رقم السند] rst2.MoveLast Me.Aajel_To = rst2![رقم السند] 'مصاريف rst.Filter = "[نوع السند]='مصاريف'" rst.Sort = "[رقم السند]" Set rst2 = rst.OpenRecordset Me.Masareef_From = rst2![رقم السند] rst2.MoveLast Me.Masareef_To = rst2![رقم السند] 'سداد rst.Filter = "[نوع السند]='سداد'" rst.Sort = "[رقم السند]" Set rst2 = rst.OpenRecordset Me.Sadad_From = rst2![رقم السند] rst2.MoveLast Me.Sadad_To = rst2![رقم السند] Exit_error_Capture2: rst.close: Set rst = Nothing rst2.close: Set rst2 = Nothing Exit Sub error_Capture2: If Err.Number = 3021 Then MsgBox "لا توجد بيانات" Resume Exit_error_Capture2 Else Debug.Print Err.Number MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر 688.1.لازام نطوره - Copy.mdb.zip

مثل ما قلت لك ، وضعت الكود على زر البحث ، بكرة ان شاء الله جربه على بياناتك الجديدة ، واخبرنا النتيجة 688.لازام نطوره.mdb.zip

أخي طارق ، انا وانت لا نتكلم على نفس الموجه ، لهذا السبب تضيع الكثير من التفاصيل ولكن هذه المرة وبعد عناء ، اعتقد بأني فهمت اللي تريد هل تريد نسخ البيانات هكذا: . جعفر