بحث مخصص من جوجل فى أوفيسنا
![]()
Custom Search
|
-
Posts
1088 -
تاريخ الانضمام
-
تاريخ اخر زياره
نوع المحتوي
المنتدى
مكتبة الموقع
معرض الصور
المدونات
الوسائط المتعددة
كل منشورات العضو طاهر اوفيسنا
-
تم الحل 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
-
ارفقت الملف للتوضيح أكثر والتعديل عليه Ftransfer.mdb
-
السلام عليكم احبتي مشرفي واعضاء المنتدى المطلوب التعدبل على الكود لكي يظهر الميساج مرة واحدة خلال كل شهر وبشرط وجود مبلغ إقتطاع واذا لم يكن وجود مبلغ الإقتطاع يظهر الميساح بعدم وجود الإقتطاع خلال هذا الشهر ويكون كذلك مرة واحدة كل شهر 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
-
اخي لو بحثت لوجدت مطلبك بالمنتدى من هنا
-
لقد اضفت وحدة نمطية احرى تفقيط التقرير اصبح يشتغل اما تفقيط الفورم فاظن المشكلة في اصدار الاكسس Base de données11.accdb
-
جرب هذا اخي 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
-
هل من فكرة حول عدم وجود حقل محسوب في نوع البيانات بأكسس 2010 ؟
-
انا استعمل اكسس 2010 وبدون حقل محسوب في نوع البيانات مالمشكلة ياترى ؟ علما انه يظهر في اي مثال معمول مثل المرفق الذي تكرمت به استاذ حالد سيسكو
-
هل يمكن إضافة شريط طباعة لتقرير منبثق
طاهر اوفيسنا replied to صالح حمادي's topic in قسم الأكسيس Access
وهو كذالك شكرا لك استاذ صالح -
هل يمكن إضافة شريط طباعة لتقرير منبثق
طاهر اوفيسنا replied to صالح حمادي's topic in قسم الأكسيس Access
-
هل يمكن إضافة شريط طباعة لتقرير منبثق
طاهر اوفيسنا replied to صالح حمادي's topic in قسم الأكسيس Access
الملف به مشكلة "عدم ظهور الصفحات الاخرى" ماعدا الصفحة الاولى فقط هذا من جهة ومن جهة اخرى عمل مشكل عندما يصبح التقرير فارغ ارجو التعديل عن كلتى المشكلتين Discount.rar -
عدم ظهور الصفحة الفارغة عند فتح التقريرRep1
طاهر اوفيسنا replied to طاهر اوفيسنا's topic in قسم الأكسيس Access
ونسيت هذا في ٢٩/١٠/٢٠١٨ at 22:19, AlwaZeeR said: من البداية التقرير Q1 داحل التقرير الفرعي Rep1 -
عدم ظهور الصفحة الفارغة عند فتح التقريرRep1
طاهر اوفيسنا replied to طاهر اوفيسنا's topic in قسم الأكسيس Access
شكرا استاذ شيفان على التوضيح ولكن لم تؤدي الى الحل حسب ماجربت الفكره على التطبيق الذي ارسل اول مرة -
عدم ظهور الصفحة الفارغة عند فتح التقريرRep1
طاهر اوفيسنا replied to طاهر اوفيسنا's topic in قسم الأكسيس Access
هل لي ان ارى كيف تم تجميع EmployeeID داخل التقرير -
عدم ظهور الصفحة الفارغة عند فتح التقريرRep1
طاهر اوفيسنا replied to طاهر اوفيسنا's topic in قسم الأكسيس Access
شكرا لك اخي الوزير هل لي ان ارى كيف تم تجميع EmployeeID داخل التقرير -
عدم ظهور الصفحة الفارغة عند فتح التقريرRep1
طاهر اوفيسنا replied to طاهر اوفيسنا's topic in قسم الأكسيس Access
للرفع -
عدم ظهور الصفحة الفارغة عند فتح التقريرRep1
طاهر اوفيسنا replied to طاهر اوفيسنا's topic in قسم الأكسيس Access
اساتذتي الكرام هل المطلب غير مفهوم ام لا يوجد حل لذالك ؟ -
السلام عليكم احي عبد القدوس48 هل لنا رؤية ماصنعت ضمن برنامج الرواتب اعتقد انه برنامج راتب ادارة جزائرية
-
السلام عليكم اساتذة ممكن مساعدة بخصوص عدم ظهور الصفحة الغارعة و الصورة تبين المطلوب ملاحظة : للعلم انه تقرير داخل تقرير قيد العمل.rar
-
-
هل بإمكان عدم ظهور الصفحات الفارغة في التقرير Rep1 قيد العمل.rar
-
غيرت استاذ وضبطت معي ولكن حبيت نعرف مالسر ؟
-
ليس في هذا التقرير استاذ بل في تقرير أخر وخاصة عند الخط العربي Sultan medium وبالتحديد عند بعض الارقام