اذهب الي المحتوي

كريمو2

04 عضو فضي
  • Content Count

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

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

السمعه بالموقع

26 Excellent

1 متابع

عن العضو كريمو2

  • الإسم الفعلي
    الإســم

البيانات الشخصية

  • Gender (Ar)
    ذكر
  • Job Title
    موظف

اخر الزوار

1,276 زياره للملف الشخصي
  1. تم الحل Private Sub cmd_Pay_installments_Click() On Error GoTo err_cmd_Pay_installments_Click Dim rst As DAO.Recordset 'Cridi and Elec Payments Set rst = CurrentDb.OpenRecordset("Select * From tbl_Loans Where [Payment_Month]=CDATE('" & Me.TxtMonth & "')") rst.MoveLast: rst.MoveFirst Rc = rst.RecordCount a1 = 0 'just a flag a2 = 0 'jusf a flag If Rc = 0 Then: MsgBox " لا توجد إقتطاعات لشهر " & Format(Me.TxtMonth, "mmmm") & " " & Year(Me.TxtMonth), vbInformation: Exit Sub If Len(rst!Payment_Made_Cridi & "") = 0 And Not IsNull(rst!Loan_Cridi) _ Or Len(rst!Payment_Made_Elec & "") = 0 And Not IsNull(rst!Loan_Elec) Then Select Case MsgBox(" هل تريد أن يتم توزيع الإقتطاعات لشهر " & Me.TxtMonth, vbYesNo + vbQuestion + vbDefaultButton1) Case vbYes For i = 1 To Rc rst.Edit 'check, maybe a manual payment is done, so don't over write it 'If Len(rst!Payment_Made_Cridi & "") = 0 And Not IsNull(rst!Loan_Cridi) Then If rst!Loan_Type = "Cridi" Then rst!Payment_Made_Cridi = rst!Loan_Cridi: rst!sadad = rst!Loan_Cridi If rst!Loan_Type = "Elec" Then rst!Payment_Made_Elec = rst!Loan_Elec: rst!sadad = rst!Loan_Elec If rst!sadad.Value = True Then rst!wada3 = "تم التسديد" Else rst!wada3 = "لم يتم التسديد" End If TheSum = TheSum + Nz(rst!Payment_Made_Cridi, 0) + Nz(rst!Payment_Made_Elec, 0) + Nz(rst!Loan_Other, 0) rst.Update rst.MoveNext Next i TheSum = Format(TheSum, "#,##0.00") MsgBox " " & "تم توزيع الإقتطاعات" & vbLf & vbLf & "مجموع الإقتطاعات = " & TheSum, , "إقتطاعات شهر" & FrenchMonth(Month(Date)) & Year(Date) Case vbNo MsgBox "لم يتم توزيع الإقتطاعات" End Select 'GoTo I_am_Done 'Other loans for, March (3) and July (7) If Month(Now()) = 3 Or Month(Now()) = 7 Then Dim rstE As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From tbl_Loans") myCriteria = "[detach]='موظف'" 'myCriteria = myCriteria & " Or [detach]='منتدب'" myCriteria = myCriteria & " Or [detach]='متعاقد كامل'" myCriteria = myCriteria & " Or [detach]='متعاقد جزئي'" myCriteria = myCriteria & " Or [detach]='عون نظافة'" Set rstE = CurrentDb.OpenRecordset("Select * From Employee Where " & myCriteria) rstE.MoveLast: rstE.MoveFirst Rc = rstE.RecordCount For i = 1 To Rc 'check if payment is already entered, if it is, then skip this Record rst.FindFirst "[Loan_Type]='Other' And [EmployeeID]=" & rstE!EmployeeID & " And [Payment_Month]=#" & Me.TxtMonth & "#" If rst.NoMatch Then rst.AddNew a2 = 1 rst!EmployeeID = rstE!EmployeeID rst!Loan_ID = 0 'rst!Loan_AwardMonth = Me.AwardMonth rst!Payment_Month = DateSerial(Year(Me.TxtMonth), Month(Me.TxtMonth), 1) 'rst!Loan_Cridi = Me.txtDiscountPerMonth 'rst!Loan_Elec= 'to be used in Elec loan Form rst!Loan_Other = 1100 'to be used in Other loan Form 'rst!Payment_Made = 'to be used each time a pyment is made rst!Loan_Type = "Other" rst!Remarks = "إقتطاع من الراتب لإشتراك شهر " & Year(Me.TxtMonth) & "/" & Month(Me.TxtMonth) rst.Update End If rstE.MoveNext Next i rstE.Close: Set rstE = Nothing End If I_am_Done: 'clean up rst.Close: Set rst = Nothing End If Exit Sub err_cmd_Pay_installments_Click: If Err.Number = 3021 Then 'No Records, ignore Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub
  2. ارفقت الملف للتوضيح أكثر والتعديل عليه Ftransfer.mdb
  3. السلام عليكم احبتي مشرفي واعضاء المنتدى المطلوب التعدبل على الكود لكي يظهر الميساج مرة واحدة خلال كل شهر وبشرط وجود مبلغ إقتطاع واذا لم يكن وجود مبلغ الإقتطاع يظهر الميساح بعدم وجود الإقتطاع خلال هذا الشهر ويكون كذلك مرة واحدة كل شهر Private Sub cmd_Pay_installments_Click() On Error GoTo err_cmd_Pay_installments_Click Dim rst As DAO.Recordset 'Cridi and Elec Payments Set rst = CurrentDb.OpenRecordset("Select * From tbl_Loans Where [Payment_Month]=CDATE('" & Me.TxtMonth & "')") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount a1 = 0 'just a flag a2 = 0 'jusf a flag If Len(rst!Payment_Made_Cridi & "") = 0 And Not IsNull(rst!Loan_Cridi) Then Select Case MsgBox(" هل تريد ان يتم توزيع الإقتطاعات لشهر" & Me.TxtMonth, vbYesNo + vbQuestion + vbDefaultButton1) Case vbYes For i = 1 To RC rst.Edit 'check, maybe a manual payment is done, so don't over write it 'If Len(rst!Payment_Made_Cridi & "") = 0 And Not IsNull(rst!Loan_Cridi) Then rst!Payment_Made_Cridi = rst!Loan_Cridi rst!sadad = rst!Loan_Cridi If rst!sadad.Value = True Then rst!wada3 = "تم التسديد" Else rst!wada3 = "لم يتم التسديد" End If TheSum = TheSum + Nz(rst!Payment_Made_Cridi, 0) + Nz(rst!Payment_Made_Elec, 0) + Nz(rst!Loan_Other, 0) 'a1 = 1 'End If 'If Len(rst!Payment_Made_Elec & "") = 0 And Not IsNull(rst!Loan_Elec) Then 'rst!Payment_Made_Elec = rst!Loan_Elec 'a1 = 1 'End If rst.Update rst.MoveNext Next i TheSum = Format(TheSum, "#,##0.00") MsgBox " " & "تم توزيع الإقتطاعات" & vbLf & vbLf & "مجموع الإقتطاعات = " & TheSum, , "إقتطاعات شهر" & FrenchMonth(Month(Date)) & Year(Date) Case vbNo MsgBox "لم يتم توزيع الإقتطاعات " End Select 'GoTo I_am_Done 'Other loans for, March (3) and July (7) If Month(Now()) = 3 Or Month(Now()) = 7 Then Dim rstE As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From tbl_Loans") myCriteria = "[detach]='موظف'" 'myCriteria = myCriteria & " Or [detach]='منتدب'" myCriteria = myCriteria & " Or [detach]='متعاقد كامل'" myCriteria = myCriteria & " Or [detach]='متعاقد جزئي'" myCriteria = myCriteria & " Or [detach]='عون نظافة'" Set rstE = CurrentDb.OpenRecordset("Select * From Employee Where " & myCriteria) rstE.MoveLast: rstE.MoveFirst RC = rstE.RecordCount For i = 1 To RC 'check if payment is already entered, if it is, then skip this Record rst.FindFirst "[Loan_Type]='Other' And [EmployeeID]=" & rstE!EmployeeID & " And [Payment_Month]=#" & Me.TxtMonth & "#" If rst.NoMatch Then rst.AddNew a2 = 1 rst!EmployeeID = rstE!EmployeeID rst!Loan_ID = 0 'rst!Loan_AwardMonth = Me.AwardMonth rst!Payment_Month = DateSerial(Year(Me.TxtMonth), Month(Me.TxtMonth), 1) 'rst!Loan_Cridi = Me.txtDiscountPerMonth 'rst!Loan_Elec= 'to be used in Elec loan Form rst!Loan_Other = 1100 'to be used in Other loan Form 'rst!Payment_Made = 'to be used each time a pyment is made rst!Loan_Type = "Other" rst!Remarks = "إقتطاع من الراتب لإشتراك شهر " & Year(Me.TxtMonth) & "/" & Month(Me.TxtMonth) rst.Update End If rstE.MoveNext Next i rstE.Close: Set rstE = Nothing End If I_am_Done: 'clean up rst.Close: Set rst = Nothing End If Exit Sub err_cmd_Pay_installments_Click: If Err.Number = 3021 Then 'No Records, ignore Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub
  4. اخي لو بحثت لوجدت مطلبك بالمنتدى من هنا
  5. لقد اضفت وحدة نمطية احرى تفقيط التقرير اصبح يشتغل اما تفقيط الفورم فاظن المشكلة في اصدار الاكسس Base de données11.accdb
  6. جرب هذا اخي salimboub24 وانسخها في الوحدة النمطية بإسم مثلا "convertir-chiffres-lettres" واستدعي الدالة =NbEnLettres([مربع النص الذي به المبلغ في التقرير];"DA";"cm") & " " Public Function ConvertNbLettres(NB, DA As String) As String Dim varnum, varnumD, varnumU, resultat, varlet Static chiffre(1 To 19) chiffre(1) = "un" chiffre(2) = "deux" chiffre(3) = "trois" chiffre(4) = "quatre" chiffre(5) = "cinq" chiffre(6) = "six" chiffre(7) = "sept" chiffre(8) = "huit" chiffre(9) = "neuf" chiffre(10) = "dix" chiffre(11) = "onze" chiffre(12) = "douze" chiffre(13) = "treize" chiffre(14) = "quatorze" chiffre(15) = "quinze" chiffre(16) = "seize" chiffre(17) = "dix-sept" chiffre(18) = "dix-huit" chiffre(19) = "dix-neuf" Static dizaine(1 To 8) dizaine(1) = "dix" dizaine(2) = "vingt" dizaine(3) = "trente" dizaine(4) = "quarante" dizaine(5) = "cinquante" dizaine(6) = "soixante" dizaine(8) = "quatre-vingt" 'traitement du cas 0 frs If NB >= 1 Then resultat = "" Else resultat = "zéro" GoTo fintraitementfrancs End If 'traitement des millions varnum = Int(NB / 1000000) If varnum > 0 Then GoSub centaine_dizaine resultat = varlet + " million" If varlet <> "un" Then: resultat = resultat + "s" End If 'traitement des milliers varnum = Int(NB) Mod 1000000 varnum = Int(varnum / 1000) If varnum > 0 Then GoSub centaine_dizaine If varlet <> "un" Then: resultat = resultat + " " + varlet resultat = resultat + " mille" End If 'traitement des centaines et dizaines varnum = Int(NB) Mod 1000 If varnum > 0 Then GoSub centaine_dizaine resultat = resultat + " " + varlet End If resultat = LTrim(resultat) varlet = Right$(resultat, 4) 'traitement du "s" final pour vingt et cent et du "de" pour million Select Case varlet Case "cent", "ingt" resultat = resultat + "s" Case "lion", "ions" resultat = resultat + " de" End Select fintraitementfrancs: resultat = resultat + " " + DA If NB > 2 Then: resultat = resultat + "s" 'traitement des centimes varnum = Int((NB - Int(NB)) * 100 + 0.5) If varnum > 0 Then GoSub centaine_dizaine resultat = resultat + " et " + varlet + " centime" If varnum > 1 Then: resultat = resultat + "s" End If ' conversion 1ère lettre en majuscule resultat = UCase(Left(resultat, 1)) + Right(resultat, Len(resultat) - 1) 'renvoi du resultat de la fonction et fin de la fonction ConvertNbLettres = resultat Exit Function 'sous programme centaine_dizaine: varlet = "" 'traitement des centaines If varnum >= 100 Then varlet = chiffre(Int(varnum / 100)) varnum = varnum Mod 100 If varlet = "un" Then varlet = "cent " Else varlet = varlet + " cent " End If End If 'traitement des dizaines If varnum <= 19 Then If varnum > 0 Then: varlet = varlet + chiffre(varnum) Else varnumD = Int(varnum / 10) varnumU = varnum Mod 10 Select Case varnumD Case Is <= 5 varlet = varlet + dizaine(varnumD) Case 6, 7 varlet = varlet + dizaine(6) Case 8, 9 varlet = varlet + dizaine(8) End Select If varnumU = 1 And varnumD < 8 Then varlet = varlet + " et " Else If varnumU <> 0 Or varnumD = 7 Or varnumD = 9 Then: varlet = varlet + " " End If If varnumD = 7 Or varnumD = 9 Then: varnumU = varnumU + 10 If varnumU <> 0 Then: varlet = varlet + chiffre(varnumU) End If varlet = RTrim(varlet) Return End Function
  7. هل من فكرة حول عدم وجود حقل محسوب في نوع البيانات بأكسس 2010 ؟
  8. انا استعمل اكسس 2010 وبدون حقل محسوب في نوع البيانات مالمشكلة ياترى ؟ علما انه يظهر في اي مثال معمول مثل المرفق الذي تكرمت به استاذ حالد سيسكو
  9. شكرا لك استاذ الطلب الثاني لم تقم بالتعديل عليه اي عند التقرير الفارغ يظهر الميساج كما بالصورة
  10. الملف به مشكلة "عدم ظهور الصفحات الاخرى" ماعدا الصفحة الاولى فقط هذا من جهة ومن جهة اخرى عمل مشكل عندما يصبح التقرير فارغ ارجو التعديل عن كلتى المشكلتين Discount.rar
  11. ونسيت هذا في ٢٩‏/١٠‏/٢٠١٨ at 22:19, AlwaZeeR said: من البداية التقرير Q1 داحل التقرير الفرعي Rep1
  12. شكرا استاذ شيفان على التوضيح ولكن لم تؤدي الى الحل حسب ماجربت الفكره على التطبيق الذي ارسل اول مرة
  13. شكرا لك اخي الوزير هل لي ان ارى كيف تم تجميع EmployeeID داخل التقرير
×
×
  • اضف...