طاهر اوفيسنا

اليك المرفق ولا تبالي ببعض الميساجات لان جداولها محذوفة 2020.mdb 2020.rar

ممكن يكون الحيار الاول استاذ اما الخيار الثاني لنفترض اني غيرت المعيار ولا اشير للنموذج القديم فهل ممكن ان افتح التقارير من جهة النماذج الخاصة بها

نعم المعيارات في الاستعلامات وفي التقارير نفسها استعلام ccp SELECT ccp.ID, ccp.NCcp, ccp.TheValue, ccp.TxtMonth, ccp.Atawet, ccp.Obsérvation, Bdgi.Année FROM ccp LEFT JOIN Bdgi ON ccp.ID = Bdgi.ID WHERE (((Year([TxtMonth]))=[Forms]![FrmCcpReport]![txtYear])); استعلام القروض SELECT Employee.EmployeeID, Employee.[Nom et Prénom], Cridi.Cridi_Date, Cridi.Cridi_ID, Cridi.Cridi_Value, Cridi.DiscountStartDate, Cridi.DiscountEndDate, Cridi.DiscountPerMonth, Cridi.Obsérvation FROM Employee INNER JOIN Cridi ON Employee.EmployeeID=Cridi.EmployeeID WHERE (((Year([Cridi_Date]))=[Forms]![FrmCridiReport]![txtYear])) ORDER BY Cridi.Cridi_Date, Cridi.DiscountStartDate; استعلام المنح SELECT Employee.EmployeeID, Employee.[Nom et Prénom], Mena7.Menha_Date, Sum(Nz(mont1,0)) AS smont1, Sum(Nz([mont2],0)) AS smont2, Sum(Nz([mont3],0)) AS smont3, Sum(Nz([mont4],0)) AS smont4, Sum(Nz([mont5],0)) AS smont5, Sum(Nz([mont6],0)) AS smont6, Sum(Nz([mont7],0)) AS smont7, Sum(Nz([mont8],0)) AS smont8, Sum(Nz([mont9],0)) AS smont9, Sum(Nz([mont10],0)) AS smont10, Sum(Nz([mont11],0)) AS smont11, [smont1]+[smont2]+[smont3]+[smont4]+[smont5]+[smont6]+[smont7]+[smont8]+[smont9]+[smont10]+[smont11] AS TheSum FROM Employee INNER JOIN Mena7 ON Employee.EmployeeID = Mena7.EmployeeID WHERE (((Year([Menha_Date]))=[Forms]![FrmMen7Report]![txtYear])) GROUP BY Employee.EmployeeID, Employee.[Nom et Prénom], Mena7.Menha_Date ORDER BY Mena7.Menha_Date;

نعم الاستعلام هو مصدر كل البيانات استاذي

السلام عليكم اساتذتنا الكرام لديا عدة تقارير تفتح بشكل عادي على حدى اي عندما يتم فتحها عن طريق الفورم الخاص بها ولكن عندما تم تجميعهم في فورم واحد وهو فورم FrmRapport وقع مشكل في فتح كل تقرير يطلب منك ادخال قيمة معلمة وهي السنة Txtyear وهذا هو حدث عند التغيير Private Sub Nome_Report_Change() On Error GoTo Err_Nome_Report_Click Dim stLinkCriteria As String stDocName = Nome_Report.Text 'stLinkCriteria = "[Nome_Report]=" & "'" & Me![Nome_Report] & "'" DoCmd.OpenReport stDocName, acViewPreview, , "Year(date()) = " & Me.txtYear & "" Exit_Nome_Report_Click: Exit Sub Err_Nome_Report_Click: If Err.Number = 2501 Then Resume Exit_Nome_Report_Click Else MsgBox Err.Description Resume Exit_Nome_Report_Click End If End Sub كيف ينم التعديل

شكرا لك استاذ احمد تمت التجربة

إقتراح جميل استاذ أبو إبراهيم الغامدي بارك الله فيك

دخلت على الرابط وماوصلت لنتيجة استاذ

تقبل الله صيامك استاذ احمد نسخت الكود في القاعدة الخاصة بي ظهر لي مشكل عند التحويل

استاذ احمد هل تم تعديل اخر عير هذا في الملف DoCmd.TransferText acExportDelim, "qry", "استعلام4", strPathAndfile & xx & ".txt", False Shell ("C:\Windows\system32\notepad.exe" & " " & strPathAndfile & xx & ".txt"), vbNormalFocus

وهو كذالك استاذ شكرا ربي يبارك فيك

شكرا لك استاذ أحمد الفلاحجى على المساعدة ولكن ياريت عدم اظهار كلمة LIGNECD في المفكرة هذا من جهة ومن جهة أخرى اريد معاينة الملف NewDisq052020 مباشرة بعدالتحويل في انتظار التعديل او الفكرة

السلام عليكم اساتذة تقبل الله صيامكم وقيامكم بالمرفق ادناه لدي مشكلة وهي عند تحويل التقرير من اكسس الى ملف TXT يظهر تباعد بين الاسطر كما في الصورة Trans CD.rar

الف مبروك استاذ husamwahab الى الامام سر في طريق مساعدة إخوتك جعلها الله في ميزان حسناتك

شكرا لك أخي على الفكرة التي كانت غائبة عني ملاحظة : لم يفي بالنتيجة الصحيحة ولكن اجريت عليه بعض التعديلات NCompte = IIf((IIf((100 * N°_Compte_du_Titulaire Mod 97) > 12, 97 - ((100 * N°_Compte_du_Titulaire Mod 97) - 12), 12 - (100 * N°_Compte_du_Titulaire Mod 97))) < 10, _ "0" & IIf((100 * N°_Compte_du_Titulaire Mod 97) > 12, 97 - ((100 * N°_Compte_du_Titulaire Mod 97) - 12), 12 - (100 * N°_Compte_du_Titulaire Mod 97)), _ IIf((100 * N°_Compte_du_Titulaire Mod 97) > 12, 97 - ((100 * N°_Compte_du_Titulaire Mod 97) - 12), 12 - (100 * N°_Compte_du_Titulaire Mod 97)))

السلام عليكم اخواني رمضان كريم ان شاء الله اللهم ارفع عنا الوباء و البلاء ببركة الشهر الفضيل يارب لدي كود معادلة من ملف اكسل حاولت تغيره للأكسس ولكن مافلحت وخاصة في الدالة MOD Function RIP_AVANT(RIP_AVAT) As Integer RIP_AVANT=IIF((IIF(MOD(100*NCompte,97)>12,97-(MOD(100*NCompte,97)-12),12-MOD(100*NCompte,97)))<10,"0"&(IIF(MOD(100*NCompte,97)>12,97-(MOD(100*NCompte,97)-12),12-MOD(100*NCompte,97))),(IIF(MOD(100*NCompte,97)>12,97-(MOD(100*NCompte,97)-12),12-MOD(100*NCompte,97)))) End Function ارجو التعديل وشكرا لكم

بارك الله فيك استاذ جعفر

من المستحسن عمل نموذج فرعي مرتبط بالنموذج الاصلي اجازة لكي تتمكن من اضافة عدة اجازات لنفس الموظف بالتوفيق

لم يفتح المرفق على اكسس 2010

تم الحل 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