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

jjafferr

أوفيسنا
  • Posts

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

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

  • Days Won

    404

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

  1. السلام عليكم ضع هذا الكود في وحدة نمطية (تستطيع ان تضيفها مع اي وحدة نمطية اخرى عندك): Public Function Sum_Alkmiah(iwerNumSenf) 'الكود القديم 'A = IIf(DSum("Alkmiah", "HRR", "Rajmsanf='" & werNumSenf() & "'" & " and month(Atarih)=5" & " and Nwaha='" & 13 & "'") > 0, _ DSum("Alkmiah", "HRR", "Rajmsanf='" & werNumSenf() & "'" & " and month(Atarih)=5" & " and Nwaha='" & 13 & "'"), 0) _ - _ IIf(DSum("Alkmiah", "HRR", "Rajmsanf='" & werNumSenf() & "'" & " and month(Atarih)=5" & " and Nwaha='" & 14 & "'") > 0, _ DSum("Alkmiah", "HRR", "Rajmsanf='" & werNumSenf() & "'" & " and month(Atarih)=5" & " and Nwaha='" & 14 & "'"), 0) 'الكود الجديد Sum_13 = DSum("Alkmiah", "HRR", "Rajmsanf='" & iwerNumSenf & "' and month(Atarih)=5 and Nwaha='13'") Sum_14 = DSum("Alkmiah", "HRR", "Rajmsanf='" & iwerNumSenf & "' and month(Atarih)=5 and Nwaha='14'") Sum_Alkmiah = IIf(Sum_13 > 0, Sum_13, 0) - IIf(Sum_14 > 0, Sum_14, 0) End Function . ثم في الاستعلام تنادي الوحدة النمطية هكذا Sum_Alk: Sum_Alkmiah(werNumSenf()) جعفر
  2. السلام عليكم اخي حسين انا انزلت المرفق المرة المسابقة ، وانزلته الان مرة اخرى ، وقمت بحذفه من المشاركة ، حتى لا تعُم الروابط (فأنت تسأل عن الخصوصة) ، وفي قسم ادارة المنتدى ، قمت بطرح طلبك على ادارة المنتدى ، ورد عليّ الاستاذ @محمد طاهر بأنه يتابع معك الوضع في موضوع آخر عملته انت ، فرجاء متابعة الموضوع مع الاستاذ محمد. جعفر
  3. يا سيدي ، المشكلة ان رقم الفاتورة عندك "نص" ، والمعادلة التي اعطيتك هي اذا كان رقم الفاتورة "رقم" وكذلك كان الخطأ مني في الكود اعلاه ، فعند مناداة النموذج الفرعي ، يجب ان نضيف كلمة .Form. تفضل هذا التعديل ، بالاضافة انه عندك بقايا في نهاية الكود: Private Sub fatora_no_AfterUpdate() Me.fry_111.Form.Filter = "[id_fatora]='" & Me.fatora_no & "'" Me.fry_111.Form.FilterOn = True Me.fry_112.Form.Filter = "[fatora_no]='" & Me.fatora_no & "'" Me.fry_112.Form.FilterOn = True 'End If End Sub جعفر
  4. وعليكم السلام اخي حسين الكود السابق يبحث عن اول سجل في النموذج الفرعي ، فانت قلت: . اما اذا كان قصدك تصفية النموذج الفرعي على اساس مربع نص النموذج الرئيسي ، فيمكنك استعمال الكود التالي : me.fry_111.filter= "[رقم الفاتورة]=" & me.tt1 me.fry_111.filteron= true me.fry_112.filter= "[رقم الفاتورة]=" & me.tt1 me.fry_112.filteron= true جعفر
  5. وعليكم السلام يجب على كل جدول ان يحتوي على حقل ترقيم تلقائي ، فهذا مهم جدا للبرنامج ، وسرعته وقد عملت لك هذا الحقل في الجدول Tabl_Itinerary ، واختصرت استعلام عدم المطابقات ، واسميته qry_Diff_tbl_Itinerary_tbl_Itinerarytemp ، كود زري الحذف: Option Compare Database Option Explicit Private Sub cmd_Delete_With_Code_Click() Dim rstQry As DAO.Recordset Dim rstTbl As DAO.Recordset Dim RCqry As Integer Dim i As Integer Dim mySQL As String Set rstTbl = CurrentDb.OpenRecordset("Select * From Tabl_Itinerary") mySQL = "SELECT Tabl_Itinerary.Auto_ID, Tabl_Itinerarytemp.Num_Itinerary" mySQL = mySQL & " FROM Tabl_Itinerary LEFT JOIN Tabl_Itinerarytemp ON Tabl_Itinerary.[Num_Itinerary] = Tabl_Itinerarytemp.[Num_Itinerary]" mySQL = mySQL & " WHERE (((Tabl_Itinerarytemp.Num_Itinerary) Is Null));" Set rstQry = CurrentDb.OpenRecordset(mySQL) rstQry.MoveLast: rstQry.MoveFirst RCqry = rstQry.RecordCount For i = 1 To RCqry rstTbl.FindFirst "[Auto_ID]=" & rstQry!Auto_ID rstTbl.Delete rstQry.MoveNext Next i rstQry.Close: Set rstQry = Nothing rstTbl.Close: Set rstTbl = Nothing MsgBox "Done" End Sub Private Sub cmd_Delete_With_Query_Click() Dim rstQry As DAO.Recordset Dim rstTbl As DAO.Recordset Dim RCqry As Integer Dim i As Integer Set rstTbl = CurrentDb.OpenRecordset("Select * From Tabl_Itinerary") Set rstQry = CurrentDb.OpenRecordset("Select * From qry_Diff_tbl_Itinerary_tbl_Itinerarytemp") rstQry.MoveLast: rstQry.MoveFirst RCqry = rstQry.RecordCount For i = 1 To RCqry rstTbl.FindFirst "[Auto_ID]=" & rstQry!Auto_ID rstTbl.Delete rstQry.MoveNext Next i rstQry.Close: Set rstQry = Nothing rstTbl.Close: Set rstTbl = Nothing MsgBox "Done" End Sub جعفر 795.Qdel.accdb.zip
  6. انا لم اعمل البرنامج ، فهو عمل الشباب ، ولكن يمكنك توقيف رسائل التحذير هكذا: في بداية الكود اكتب DoCmd.SetWarnings False يأتي الكود هنا وفي نهاية الكود اكتب DoCmd.SetWarnings True . [utv
  7. وعليكم السلام تفضل . هذه الوحدة النمطية الموجودة في Help الاكسس ، مع بعض التعديل Option Compare Database Option Explicit Public Function YMDDif(sDate1, sDate2) 'sdate1 earliest date sdate2 later Dim iYear As Integer Dim iMonth As Integer Dim iDay As Integer Dim dInterim1 As Date Dim D As Integer Dim M As Integer Dim Y As Integer iMonth = DateDiff("m", sDate1, sDate2) If Day(sDate1) > Day(sDate2) Then iMonth = iMonth - 1 End If dInterim1 = DateAdd("m", iMonth, sDate1) iDay = DateDiff("d", dInterim1, sDate2) D = iDay M = iMonth Mod 12 Y = iMonth \ 12 YMDDif = CStr(Y) & " س/" & CStr(M) & " ش/" & CStr(D) & " ي" End Function Public Function YMDDif2(sDate1, sDate2) 'sdate1 earliest date sdate2 later Dim iYear As Integer Dim iMonth As Integer Dim iDay As Integer Dim dInterim1 As Date Dim D As Integer Dim M As Integer Dim Y As Integer iMonth = DateDiff("m", sDate1, sDate2) If Day(sDate1) > Day(sDate2) Then iMonth = iMonth - 1 End If dInterim1 = DateAdd("m", iMonth, sDate1) iDay = DateDiff("d", dInterim1, sDate2) D = iDay M = iMonth Mod 12 Y = iMonth \ 12 YMDDif2 = CStr(M) & " ش" End Function . اما التقرير ، فيأخذ بياناته من هذا الحدث ويعطينا الفرق باليوم ، والشهر ، والسنة (احذف السطر اللي ما تريده) Private Sub PageFooterSection_Format(Cancel As Integer, FormatCount As Integer) Me.txtcount = DLookup("[التاريخ]", "[Query1]", "[Query1]![CountOfالتسلسل]=" & [نص128]) Me.txtcounupgrade = DLookup("[التاريخ]", "[Query1]", "[Query1]![CountOfالتسلسل]=" & [نص130]) Me.Months = YMDDif(Me.txtcount, Me.txtcounupgrade) & vbCrLf & _ "او" & vbCrLf & _ YMDDif2(Me.txtcount, Me.txtcounupgrade) End Sub جعفر 794.حساب عدد الاشهر بين تاريخين.accdb.zip
  8. me.fry_111.SetFocus me.fry_111![رقم الفاتورة].SetFocus DoCmd.FindRecord Me.tt1, , , , , , True وعليكم السلام هذا الكود للنموذج الفرعي الاول ، ويمكنك تغييره للنموذج الفرعي الثاني جعفر
  9. انا انزلت المرفق في اول مشاركة لك ، ومجرد اضفت هذا السطر (باللون الاحمر) ، في مكانين مختلفين: rst.edit rst!mjmo = rst!Alkmiah * rst!Price rst!safi = rst!Alkmiah * rst!Price * (1 - Me.Percentage_Discount) ولم المس اي شيء آخر. جعفر
  10. وعليكم السلام ابو زاهر هل هذا الذي تريده؟ جعفر 792.المجموع.mdb.zip
  11. السلام عليكم اختي الفاضلة: 1. زر "أبلغ فريق الموقع عن مخالفة" هو لإبلاغ مشرفي الموقع عن إساءة في مشاركة ، ولا علاقة لها بصاحب الموضوع ، 2. هذا الموضوع تم مناقشته في 2015 ، فيُعتبر مُغلق للمشاركات الجديدة. رجاء افتحي موضوع جديد ، واشرحي فيه طلبك ، واتركي فيه رابط لهذا السؤال جعفر
  12. الحين عرفت ، اسألتك السهلة عبارة عن طُعم ، لما تصيد الجواب ، تهجم عليه بالسؤال الصعب شتان بين حذف سجل ، وحذف مجموعة سجلات في النموذج الفرعي!! في النموذج الرئيسي ، اعمل الحدثين: Option Compare Database Option Explicit Private Sub cmd_Delete_Click() 'اذا اخترت السجل في النموذج الفرعي ، ثم ضغطت زر الحذف من النموذج الرئيسي مباشرة 'Screen.PreviousControl.SetFocus 'DoCmd.RunCommand acCmdDeleteRecord 'اما اذا اخترت السجل في النموذج الفرعي ، ثم اخذت لك لفة على كائنات النموذج الرئيسي 'فيجب ان يجب ان نخبر الكود ان عملنا سيكون على النموذج الفرعي 'frm_tap = اسم النموذج الفرعي 'Me.frm_tap.SetFocus 'DoCmd.RunCommand acCmdDeleteRecord Call Form_frm_tap.Delete_Record End Sub Private Sub frm_tap_Exit(Cancel As Integer) Call Form_frm_tap.rowsSelected End Sub . وفي النموذج الفرعي ، اعمل هذه الاحداث: Option Compare Database Option Explicit Dim Selected_Rows() As String Dim i As Integer Dim rst As DAO.Recordset Dim ctrl_Name As String ' Public Sub rowsSelected() ctrl_Name = "sit_no" Dim selH As Long, selT As Long ReDim Selected_Rows(0) selH = Me.SelHeight selT = Me.SelTop - 1 If Me.SelHeight <> 0 Then ReDim Selected_Rows(Me.SelHeight) Set rst = Me.RecordsetClone rst.MoveFirst: rst.Move selT For i = 0 To Me.SelHeight - 1 Selected_Rows(i) = rst(ctrl_Name) rst.MoveNext Next rst.Close: Set rst = Nothing End If End Sub Public Sub Delete_Record() On Error GoTo err_Delete_Record Set rst = Me.RecordsetClone For i = LBound(Selected_Rows) To UBound(Selected_Rows) - 1 rst.FindFirst "[" & ctrl_Name & "]=" & Selected_Rows(i) rst.Delete Next i Exit_Delete_Record: rst.Close: Set rst = Nothing Exit Sub err_Delete_Record: If Err.Number = 9 Then Resume Exit_Delete_Record Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub . رجاء ملاحظة: 1. لازم تعطي اسم الحقل الى المتغير ، من هنا: ctrl_Name = "sit_no" 2. في الكود ، انا استعملت حقل رقم (انظر الكود اعلاه) ، فإذا استعملت حقل نص ، فيجب: تبديل هذا السطر rst.FindFirst "[" & ctrl_Name & "]=" & Selected_Rows(i) الى rst.FindFirst "[" & ctrl_Name & "]='" & Selected_Rows(i) & "'" جعفر 786.Delete_SubForm_Records.mdb.zip
  13. انا لا املك هذه البرنامج ، وقوانين المنتدى لا تسمح بإرفاقها: 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة. جعفر
  14. وعليكم السلام هذه طريقة اصطياد رقم رسالة الخطأ . وعند الحصول على رقم الخطأ ، اذهب الى مشاركتي التالية في الموضوع عاليه. جعفر
  15. وعليكم السلام تفضل اذا اخترت السجل في النموذج الفرعي ، ثم ضغطت زر الحذف من النموذج الرئيسي مباشرة Screen.PreviousControl.SetFocus DoCmd.RunCommand acCmdDeleteRecord اما اذا اخترت السجل في النموذج الفرعي ، ثم اخذت لك لفة على كائنات النموذج الرئيسي فيجب ان يجب ان نخبر الكود ان عملنا سيكون على النموذج الفرعي frm_tap = اسم النموذج الفرعي Me.frm_tap.SetFocus DoCmd.RunCommand acCmdDeleteRecord جعفر
  16. السلام عليكم الظاهر ان هذه مشكلة معروفة عند تنصيب اكثر من اصدار من الاكسس ، والافضل هو تنصيب برنامج اكسس واحد ، ثم تنصيب برنامج VMware ، منه تنصب النسخة الاخرى (انا قرأت هذه المعلومة) ، اما اختنا الفاضلة الدكتورة ام عهود فتقول انها قامت بتنصيب نسخ 3 من الاكسس ، هكذا: http://arabteam2000-forum.com/index.php?/topic/263020-كيف-انصب-نسختي-اوفيس-باصدارين-مختلفين-على-جهازي/&do=findComment&comment=1286995 جعفر
  17. اذن نحن بحاجة الى مرفق ، ومثال جعفر
  18. السلام عليكم جرب التالي: بإستعمال الاكسس 2003 ، افتح قاعدة بيانات جديدة ، ثم استورد جميع الكائنات من قاعدة البيانات السابقة ، واخبرنا النتيجة لوسمحت جعفر
  19. السلام عليكم اخي طاهر ، رجاء ارفق هذه الجزئية فقط من برنامجك ، علشان نعدل مباشرة عليها ، ورجاء اعطنا مثال نستطيع ان نقتدي به لعمل اللازم. جعفر
  20. وعليكم السلام اخي شفان الظاهر انا وانت تم مراسلتنا!! تفضل هذا الكود المعدل: Dim SRV As Integer Dim rs As DAO.Recordset If ([userpassfinder] & vbNullString) = vbNullString Then Exit Sub 'هذا الامر أبطأ من الامر التالي 'SRV = DLookup("[UserPass]", "tblUsers", "[UserPass] = " & [userpassfinder]) 'If IsNull(SRV) Then ' MsgBox "الرقم السري غير صحيح" ' Me.userpassfinder.SetFocus ' Exit Sub 'End If 'هذا الامر اسرع SRV = DCount("*", "tblUsers", "[UserPass] = " & [userpassfinder]) If SRV = 0 Then MsgBox "الرقم السري غير صحيح" Me.userpassfinder.SetFocus Exit Sub End If 'الحل الاول DoCmd.OpenForm "frm" Forms!frm.SetFocus Forms!frm!fsubUser.SetFocus Forms!frm!fsubUser!UserPass.SetFocus DoCmd.FindRecord Me.userpassfinder, , , , , , True 'الحل الثاني ' DoCmd.OpenForm "frm" ' Set rs = Forms!frm!fsubUser.Form.RecordsetClone ' rs.FindFirst "[UserPass] = " & Me.userpassfinder ' If rs.NoMatch Then ' MsgBox "wrong Pass", _ ' vbOKOnly + vbInformation ' Else ' Forms!frm!fsubUser.Form.Bookmark = rs.Bookmark ' End If ' rs.Close ' userpassfinder = Null جعفر 791.Database3.accdb.zip
  21. السلام عليكم اخي @غريب طرابلس يوجد قسم اعلانات شخصية للاعضاء ، والذي تستطيع ان تعرض برامجك للبيع ، مع مراعاة وضع طريقة الاتصال بك في الموضوع: https://www.officena.net/ib/forum/157-إعلانات-شخصية-للاعضاء/ وشكرا اخي @صالح حمادي وانا ذكرت هذه الطابعة في المادة هـ.3. جعفر
  22. آسف ، اذن هي 3 تصاريح هذا رابط به الطريقة التي كنت تريدها اصلا للدكتورة أم عهود ، الطباعة من الجانبين: http://arabteam2000-forum.com/index.php?/topic/276385-ظهور-بيانات-التقرير-في-عمودين/ جعفر
  23. وتفضل 789.توزيع الخصم للسجلات بالفاتوره.mdb.zip
  24. وعليكم السلام اليك طريقة اسهل: في نفس ورقة التقرير ، ضع الواجهة ، والخلفية جنبا الى جنب ، بترك مسافة قصيرة بينهم ، بهذه الطريقة ستطبع 6 تصاريح على ورقة واحدة من جهة واحدة ، اقطع كل تصريح ، ثم قم واثني التصريح بين الواجهة والخلفية ، ثم استخدم تغليف بلاستيك ، فيصبح التصريح له واجهة وخلفية هذا ما عملته انا بتصاريحي جعفر
×
×
  • اضف...

Important Information