jjafferr

أخي والله ضعت وما اعرف شو اللي تريده ، مرفق هو نتيجة البرنامج اللي ارفقته انت ، ويعطي نف النتيجة اللي طلبتها: يعني برنامجك يعطي النتائج اللي تريدها بالنموذج اللي تريده ، شو المطلوب اذا؟ جعفر

السلام عليكم أخي وائل في الواقع نظرت الى الكود الذي ذكرته ، ووجدت فيه مجال لتحسينه ، ولكن لا اعرف اذا كانت المشكلة هنا او في مكان آخر ، هذا هو الكود ، جربه واخبرني: Private Sub sav_Click() ' On Error Resume Next DoCmd.Beep DoCmd.SetWarnings False If MsgBox("سوف يتم حفظ الفاتورة بعد طباعتها. تريد بالفعل اكمال العملية ", vbYesNo + vbInformation + vbMsgBoxRight + vbDefaultButton1, "تنبيـــه") = vbNo Then DoCmd.RunCommand acCmdDeleteRecord SendKeys "{ESC}" MsgBox "لقد تم إلغاء عملية الطباعة والحفظ ", vbMsgBoxRight + vbInformation, "" Refresh DoCmd.close End If If (DLookup("[s]", "Torderno", "[orderno]=" & Me.orderno) = True) Then MsgBox " خطــأ... الفاتورة محفوظة من قبل ", vbCritical, " خطــأ 1 " DoCmd.CancelEvent DoCmd.close End If If IsNull(DLookup("[orderno]", "Torder", "[orderno]=" & Me.orderno)) Then MsgBox " خطــأ... لا يوجد اصناف بالفاتورة ", vbCritical, " خطــأ 2 " DoCmd.CancelEvent DoCmd.close End If If Me.num > 0 Then MsgBox " خطــأ... لم يتم الانتقال الي فاتورة جديدة ", vbCritical, " خطــأ 3 " DoCmd.CancelEvent DoCmd.close End If If IsNull(Me.totalinvoice) Or IsNull(Me.itemcount) Then MsgBox "ادخل اصناف الفاتورة ", vbInformation, " " Me.F_ordersubform.SetFocus Exit Sub 'jj End If If (Me.totalinvoice) = 0 Then MsgBox "ادخل اصناف الفاتورة ", vbInformation, " " Me.F_ordersubform.SetFocus Exit Sub 'jj End If If IsNull([F_ordersubform]![Qty]) And ([F_ordersubform]![itemcode]) > 0 Then MsgBox "ادخل العدد ", vbInformation, " " Me.F_ordersubform.SetFocus [F_ordersubform]![Qty].SetFocus Exit Sub 'jj End If If Me.discount > Me.totalinvoice Or Me.totalinvoice < 0 Then MsgBox "مبلغ الخصم اكبر من مبلغ الفاتورة ...! ", vbCritical, " خطــــأ " Me.discount = 0 ' Me.cash.SetFocus ' Me.discount.SetFocus Exit Sub 'jj End If ' DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 Me.tim.Value = Format(Time, "hh:mm AMPM") Me.cashier = USID Me.due = Me.amount Me.num.Value = Format([orderno], "0000000") Refresh Set Q = CurrentDb.OpenRecordset("SELECT torderno.orderno, torderno.s FROM [torderno] where s=false;") Q.Edit Q!s = True Q.Update Refresh DoCmd.OpenReport "s", acViewNormal, , "[orderno] = " & Me![orderno] Refresh 'On Error Resume Next 'DoCmd.SetWarnings False DoCmd.GoToRecord , , acNewRec If Me.orderno > 0 Then DoCmd.close Exit Sub Else Refresh Call MyOutoNum F_ordersubform.SetFocus DoCmd.GoToControl "itemcode" Refresh End If Exit Sub End Sub في الطريقة السابقة ، الكود كان يرى واحد من if او elseif ولا يرى البقية. وجرب هذا في الكود السابق: عندما تأتي رسالة: سوف يتم حفظ الفاتورة بعد طباعتها. تريد بالفعل اكمال العملية اختر نعم ، ولكن الكود لا يحفظ شئ (حيث انه يقفز لنهاية الكود ، وذلك بسبب الكود يرى واحد من if او elseif ولا يرى البقية. جعفر

لا ما ضبطت !! يمكن في شئ آخر لازم تعمله !! على العموم ، مادام يشتغل ، فهو المطلوب ، مع وضع ملاحظة عن المرجع االمستخدم جعفر

عليكم السلام أخي رمهان عمل جميل بس لما شغلته ظهر لي انك مستعمل الاوفيس 2013 ، لهذا السبب ، مرجع اللوورد مفقود عندي (انا استعمل اكسس 2010): فبدل ما اخلي لي مرجع الوورد 2010 ، عملت التالي (اللي في المربع الاحمر ، استعملت الـ Object): بهذه الطريقة ، فالبرنامج لا يحتاج الى اي مرجع ، ويشتغل على كل انواع الوورد جعفر

تفضل 1. عملنا جدول لحفظ اللون (بينما في الرابط اللي اعطيتك ، تحفظ مجموعة صفات للحقل ، مثل 1. اسم الخط ، 2. حجم الخط ، 3. ثخانة الخط ، 4. منحني ، 5. تحته خط ، 6. لون الخط) ، 2. في النموذج frm_2 في الحقل اللي لونه اصفر: انقر مرتين في الحقل ، يظهر لك شاشة اختيار اللون ، اختار اللون ، وسيتم حفظ اللون في الجدول ، الان افتح النموذج frm_3 ، ستجد انه يأخذ لونه من الجدول جعفر 28.Color_Combobox.mdb.zip

على حدث زر الاعمال الصحية والدهانات ، اكتبي هذا الكود Private Sub Command34_Click() DoCmd.OpenForm "FormAS", , , "[PostN]=" & Me.PostN End Sub جعفر

تفضل يا سيدي (مع اني مش عارف انك جبت مهندس جعفر منين ) احذف كود الزر القديم ، والصق هذا الكود: 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 جعفر

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