jjafferr

تفضل يا سيدي (مع اني مش عارف انك جبت مهندس جعفر منين ) احذف كود الزر القديم ، والصق هذا الكود: Private Sub Command57_Click() 'save the existing Record If Me.Dirty Then Me.Dirty = False 'Don't show any wanrnings DoCmd.SetWarnings False 'creat the required number of copies For I = 1 To Me.k_no DoCmd.OpenQuery "Qry_All" Next I 'show warnings again DoCmd.SetWarnings True End Sub للعلم ، الرسالة اللي كنت تحصل عليها مش رسالة خطأ ، وانما رسالة تنبيه بانك راح تضيف سجل للجدول ، السطرين اللي زيدتهم في الكود ، الاول قبل اضافة السجل ، ونقول للبرنامج ، لا تعطيني رسائل تنبيهات ، والبرنامج راح يدخل السجلات بدون رسائل تنبيه ، ولما الالحاق يخلص ، نقول للبرنامج اسمح لرسائل التنبيه تظهر (هذا الامر غير مقتصر على الكود ، وانما على برنامج الاكسس بالكامل) جعفر

آسف ، ما جربت البرنامج كفاية الان تم تجربته بالكود التالي: Private Sub Command2_Click() On Error GoTo err_Command2_Click Dim ImportFileName As String ImportFileName = CurrentProject.Path & "\MyBackup\سجل الكتب" & ".xls" 'DoCmd.TransferSpreadsheet acImport, 8, "جدول تسجيل الكتب", ImportFileName, True DoCmd.DeleteObject acTable, "Temp" DoCmd.TransferSpreadsheet acImport, 8, "Temp", ImportFileName, True Dim fld As Field Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Temp") mySQL = "INSERT INTO [جدول تسجيل الكتب] ( title, [اسم المؤلف], [مكان النشر], الناشر, ملاحظات ) Select" For Each fld In rst.Fields i = i + 1 If i <> 1 Then mySQL = mySQL & " [" & fld.Name & "]," End If Next mySQL = Mid(mySQL, 1, Len(mySQL) - 1) & " From Temp" 'Debug.Print mySQL CurrentDb.Execute (mySQL) DoCmd.DeleteObject acTable, "Temp" MsgBox "Done" Exit Sub err_Command2_Click: If Err.Number = 7874 Then 'table Temp not found, ignore Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر جعفر

وللعلم ، انا عملت على طريقة الاكسس ، وسابقا عملت برنامج لطباعة الارقام على شيكات البنوك ، وببعض المحاولات لتضبيط الحقول ، والبرنامج شغال تمام جعفر

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

وعليكم السلام ما لك شغل فيهم ، الكود يعمل كل شئ بنفسه جعفر

أخي الفاضل رجاء توضح وتشرح زيادة ، لاننا ما فاهمين بعض!! 1. انت: حساب مدة عمل الموظف من تاريخ التعيين وحتى تاريخ التقاعد بحيث يأخذ في الاعتبار الاشهر التي بها 30 يوم والاشهر التي بها 31 يوم وشهر 2 إذا كان فيه 28 يوم أو 29 يوم 2. انا: كود حساب الفرق بين تاريخين (موجود في الاكسس ، اذا ضغطت على F1 وانت في VBA) ، فهو يحسب المدة ، آخذ في الاعتبار السنوات الكبيسة والبسيطة 3. انت: ما زال يطلع عندي خطأ في التقرير ، أريد الاحتساب على طريقتنا بس كيف يمكن لي أن أظهر في النموذج آخر مدة من دون تفصيل في طريقة الاحتساب كما في النموذج المرفق 4. انا: عني انت ما تريد طريقة حسابي ، وانما تريد طريقة حسابك ، صح؟ لوسمحت تعبئي لي نموذج وترسله ، لاني مافهمت قصدك 5. انت: مرفق أمثلة 6. انا: ايش دخل المثال اللي ارسلته في رقم 5 ، بالطريقة اللي عرضتها في الرقم 3؟ الله يخليك: أ- هل تريد ان تستعمل الكود (وليس شكل النموذج) ، هل تريد استعمال الكود اللي انا اعطيتك او الكود اللي انت تستعمله؟ ب- رجاء عبئ لي مثال على نفس النموذج اللي تريدني اعمل لك الكود عليه (يعني اريد اعرف اخلي الارقام في اي حقول). جعفر

وعليكم السلام أخوي ابراهيم هالله هالله و شوي شوي علينا انت الله هداك مسمي الاستعلام نفس اسم التقرير ، والنموذج نفس اسم الجدول لازم تميزهم عن بعض ، علشان المسألة تصير سهلة عليك وعلينا ، وعلشان برمجتك تصير صحيحة البارحة ما انتبهت للمعلومات اعلاه ، فكنت اعتقد بان q_all هو اسم استعلام وما انتبهت للكود openReport ، فاعتقدت بانه OpenQuery ، وهذا كله بسبب التسميات واخي رمهان ماقصر ، واخبرني عن هذه الغلطة ، لكني شفت رسالته ورسائلك اليوم الصبح. تفضل ، التعديل والسموحة جعفر 31.Inpaco - Copy.accdb.zip

وعليكم السلام أخي ابراهيم 1. الكود صحيح اللي انت عملته: Private Sub Command57_LostFocus() Dim I As Byte Dim copyN As Integer copyN = Me.k_no For I = 1 To copyN DoCmd.OpenReport "q_all" Next I End Sub ولكن بدله ، علشان ما يكون على حدث اللي هو عليه الان ، وانما لازم يكون على حدث ضغط الزر ، هكذا: Private Sub Command57_Click() Dim I As Byte Dim copyN As Integer copyN = Me.k_no For I = 1 To copyN DoCmd.OpenReport "q_all" Next I End Sub 2. في البرنامج ، غير الاستعلام q_all من استعلام عادي ، الى استعلام الحاق ، بس لا تعمل الحاق للحقل Serial. جعفر

أخوي محسن ، اشوفك واجد مدلعني

تفضل أخي وأستاذنا الكريم عبدالعزيز تفضل هذا الرابط لمثل هذا السؤال: http://www.officena.net/ib/index.php?showtopic=58653 جعفر

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

شكرا جزيلا لك أخي أبوخليل بس هاي المواضيع المتميزة المثبتة وين رابطها؟ جعفر

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

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

السلام عليكم ورحمة الله وبركاته أخي اباعمرو ضع هذا الكود على زر استيراد جدول (بدل الكود القديم) Private Sub Command2_Click() Dim ImportFileName As String ImportFileName = CurrentProject.Path & "\MyBackup\سجل الكتب" & ".xls" 'DoCmd.TransferSpreadsheet acImport, 8, "جدول تسجيل الكتب", ImportFileName, True DoCmd.DeleteObject acTable, "Temp" DoCmd.TransferSpreadsheet acImport, 8, "Temp", ImportFileName, True Dim fld As Field Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Temp") mySQL = "INSERT INTO [جدول تسجيل الكتب] ( title, [اسم المؤلف], [مكان النشر], الناشر, ملاحظات ) Select" For Each fld In rst.Fields i = i + 1 If i <> 1 Then mySQL = mySQL & " [" & fld.Name & "]," End If Next mySQL = Mid(mySQL, 1, Len(mySQL) - 1) & " From Temp" 'Debug.Print mySQL CurrentDb.Execute (mySQL) End Sub جعفر

ان شاء الله باصداراتها التالية والمحسنة جعفر

يا أبوخليل ، كان زين انك من زمان تذكر الورد علشان تنشط ذاكرة أخينا ومهان فكر بشئ أخر كذلك محفز ومنشط جعفر

هلا والله بالمحسن

الله يطول في عمرك أخوي هاي نتيجة حسابكم وهاي نتيجة حسابي وانت قرر جعفر

وعليكم أخي وائل صحيح انا شايب ، بس مب من زمان الديناصورات وانزلت مرفق الكود ، ولم اجد به بصماتي (نعم ، استطيع ان ارى بصمتي في الكود ) والآن ، فلنبدأ بصفحة جديدة ما هو المطلوب (وبالتفصيل لوسمحت) ، ورجاء ارفاق ملفك جعفر

أخي محسن كل اللي كنت محتاج له هو رقم الملف الكود السابق كان للمجلد الذي تم اختياره فقط ، غير هذا الكود: Private Sub cmdfrom_Click() 'open the Open Folder dialog Me.DataBaseFromPath = BrowseFolder("which folder") 'if the user didn't select any folder, exit If Len(Me.DataBaseFromPath & "") = 0 Then Exit Sub 'list the .mdb files from the folder Call ListFiles(Me.DataBaseFromPath, "*.mdb", , Me.lst_Files) 'list the .accdb files from the folder Call ListFiles(Me.DataBaseFromPath, "*.accdb", , Me.lst_Files) End Sub والكود الحالي يشمل جميع المجلدات اللي داخل المجلد الذي تم اختياره ، فغير الكود اعلاه الى: Private Sub cmdfrom_Click() 'open the Open Folder dialog Me.DataBaseFromPath = BrowseFolder("which folder") 'if the user didn't select any folder, exit If Len(Me.DataBaseFromPath & "") = 0 Then Exit Sub 'list the .mdb files from the folder Call ListFiles(Me.DataBaseFromPath, "*.mdb", True, Me.lst_Files) 'list the .accdb files from the folder Call ListFiles(Me.DataBaseFromPath, "*.accdb", True, Me.lst_Files) End Sub جعفر

شكرا أخي رضون

أخي محسن الرابط التالي يعطيك طريقة اخرى لعمل اللي تريده: http://www.officena.net/ib/index.php?showtopic=59784&p=383494 جعفر

وعليكم السلام أخي رمهان جميل جدا ، فكرة رائعة وبسيطة في الواقع هناك سؤال ينطبق عليه مثالك ، وهو: http://www.officena.net/ib/index.php?showtopic=59803 وساذكر هناك رابط مثالك جميل