نجوم المشاركات

السلام عليكم 🙂 عندنا تقرير بهذه الطريقة : . ونريد نعملة بهذه الطريقة : . نعمل التقرير ، ثم نعمل مجاميع لأي من الحقول ، ثم نعمل حقل ليحسب عدد السجلات للمجموعة : . ويجب عمل برواز الحقول شفاف : ---------------------------------------------------------------------- التعديل - 1 ، 27/11/2020 تصحيح البرنامج ، على فرضية اطوال السجلات مختلفة وتحتوي على اكثر من سطر ثم نرسل هذه البيانات للوحدة النمطية Box_Lines التي تقوم بعمل البرواز : نرسل اسم الحقل المطلوب عمل المربع الكبير حوله ، ولون الخط ، ولون البرواز ، وعدد سجلات المجموعة : Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer) 'No way to adjust the field Height, so we Draw a Box around the new Height Call apply_Max_Height("rpt", 0, "save", RGB(221, 217, 195)) 'Expand the field to be the size of the combined Records 'Call Box_Lines(fld , Text Fore color, Border Color, Group_Record_Count) 'Call Box_Lines(Me.Name, "save", vbBlack , vbBlack , Me.save_Footer) Call Box_Lines(Me.Name, "save", RGB(16, 37, 63), RGB(221, 217, 195), Me.save_Footer) End Sub . واستخدمت الوحدة النمطية لأخونا العود ابو خليل من هنا ، لضبط اطوال جميع السجلات الى الاطول : طلب كود تنسيق نمو حقول التقرير - قسم الأكسيس Access - أوفيسنا (officena.net) وتقوم الوحدة النمطية Box_Lines بعمل المطلوب ، بعمل حقل واحد (للجقل المطلوب) : Option Compare Database Option Explicit Dim str_Text As String Dim int_Counter As Integer Public fildMaxHeight As Integer Dim ctl As Control ' Public Function Box_Lines(rpt_Name As String, fld_Name As String, rgb_Fore As Long, rgb_Border As Long, Group_Record_Count As Integer) Dim L As Single Dim T As Single Dim W As Single Dim H As Single Set ctl = Reports(rpt_Name)(fld_Name) 'make it simple to understand L = ctl.Left W = ctl.Width T = ctl.Top H = ctl.Height 'take the highst Height If fildMaxHeight > H Then H = fildMaxHeight End If 'this is to know when a new Group starts If ctl <> str_Text Then str_Text = ctl int_Counter = 1 End If ctl.BorderColor = vbWhite ctl.ForeColor = vbWhite Reports(rpt_Name).Line (L, T)-(L, W), rgb_Border 'Left Line Reports(rpt_Name).Line (W, T)-(W, H), rgb_Border 'Right Line 'COULDN'T GET IT TO WORK ' If int_Counter = Group_Record_Count Then 'Last Record ' Reports(rpt_Name).Line (L, H)-(W, H), rgb_Border 'Bottom Line ' End If If int_Counter = 1 Then 'First Record ctl.ForeColor = rgb_Fore 'Text ForeColor Reports(rpt_Name).Line (L, T)-(W, T), rgb_Border 'Top Line End If int_Counter = int_Counter + 1 End Function Public Function find_Max_Height(rpt_Name As String, Section_Number As Integer) fildMaxHeight = 0 For Each ctl In Reports(rpt_Name).Section(Section_Number).Controls If ctl.Height > fildMaxHeight Then fildMaxHeight = ctl.Height End If Next End Function Public Function apply_Max_Height(rpt_Name As String, Section_Number As Integer, Exclude_fld_Name As String, rgb_Border As Long) fildMaxHeight = 0 'get the max Height For Each ctl In Reports(rpt_Name).Section(Section_Number).Controls If ctl.Height > fildMaxHeight Then fildMaxHeight = ctl.Height End If Next 'Draw lines around the fields For Each ctl In Reports(rpt_Name).Section(Section_Number).Controls If ctl.Name <> Exclude_fld_Name Then Reports(rpt_Name).Line (ctl.Left, ctl.Top)-Step(ctl.Width, fildMaxHeight), vbWhite, BF Reports(rpt_Name).Line (ctl.Left, ctl.Top)-Step(ctl.Width, fildMaxHeight), rgb_Border, B End If Next End Function . -------------------------------------------------------------------- النسخة اعلاه فيها خطأ ، فرجاء استعمال النسخة الاحدث ، والتي نستطيع فيها العمل على اكثر من حقل : جعفر 1293.1.Report_Draw_BoxLine.mdb.zip

هديتى برنامج مخزنى و دليل حسابات_ECO2_DuClick_store_ بفورم بحث و اضافه بسم الله الرحمن الرحيم ( رَبَّنَا آتِنَا مِن لَّدُنكَ رَحْمَةً وَهَيِّئْ لَنَا مِنْ أَمْرِنَا رَشَدًا ) تحياتى و ايام مباركه ايام مبشره و هموم راحله يا الله هديتى لكل اعضاء المنتدى برنامج دليل حسابات و مخازن ECO2_DuClick_store مميزات البرنامج ( يمكن تطويعه لاستخدامات اخرى ) كود رقم الصنف تلقائى ارصدة الاصناف تلقائى فورم بحث و اضافه استخراج رصيد حركة الصنف بين تاريخين سهولة البحث عن البنود / الاصناف عند الادخال بحركة اليوميه سهولة التنقل بين الصفحات كود طباعة كارت الصنف و ارصدة الاصناف البرنامج مفتوح المصدر للجميع للاستفاده من الاكواد و المعادلات يمكن التعديل عليه لزيادة نطاق الصفوف بسحب المعادلات يمكن استخدامه للافراد و للشركات لاتنسونا من صالح الدعاء ECO2_DuClick_store اضافة قيمه و سعر.xlsm ECO2_DuClick_store.xlsm

جرب هذا الملف Arabic_days.xlsx

تفضل اخي هذه المحاولة ارجو من الله ان يكون هو طلبك between2.accdb

وعليكم السلام اتفضل ان شاء الله يكون ما تريد NSave: Right([save];Len([save])-Len(Left([save];1))) بالتوفيق onevalue (1)(1).accdb

وعليكم السلام 🙂 اذا كان اسم الحقل A ، استعمل : me.A = not me.A جعفر

تفضل مع زيادة حبتين الموسطي.xlsx

السلام عليكم مشاركة مع استاذي العزيز الفلاحجى اخ Matin_Murad وصفك للمطلوب غير صحيح فهناك عبارة التعامل مع سجلات مكررة وهو ما فهمه استاذ احمد منك وكان حله صحيح اما ما تريده هو التعامل مع قيم مكررة في حقل وهو حل اخر بالاضافة يجب ان توضح مصير الحقول الاخرى بحيث هل تريد القيمة الاولى ام الاخيرة ام المجموع وهذا تعديل بطلبك مع مجموع الحقل الثاني وعذرا للاطالة onerecord-1.rar

هديتى برنامج جاهز_طباعة شيكات بنك_التجارى الدولى_CIB_مع امكانية اضافة بنوك اخرى تحياتى و ايام مباركه سبحان الله و بحمده مرفق برنامج بسيط جاهز للطباعه على شيكات بنك التجارى الدولى_مصر_CIB مميزات البرنامج يتم التفقيط تلقائى بالجنيه المصرى كود بحث و اضافه دبل كليك عن المستفيد امكانية اضافة عدد لا نهائى من البنوك مع ضبط ابعاد الشيك كود طباعه للشيك لاضافة اى بنك جديد من صفحه جديده الاكسيل من view اضغط على page layout و حدد ابعاد الشيك ابقى حدد نطاق الطباعه من print area و من print preview اجعل paper size envelope 10 يوجد بدفتر الشيكات قبل نهايته نموذج ورق لعروض البنك اقطعه و اقطع ورق تصوير على قده و ابدأ ضبط فورم الاكسيل على الشيك و ابدأ اطبع نموذج الاكسيل و ضعه خلف اصل شيك من دفتر الشيكات و شوف فى الضؤ هل الفريم المطبوع مناسب لاماكن الرقم و التفقيط و التاريخ لا تنسونا من صالح الدعاء برنامج الطباعه على Check_cib_2018.xlsm

Ab_has.xlsm

الكود Sub hid_rows() Dim Hide_range As Range Dim i% i = 5 Range("A5").CurrentRegion.EntireRow.Hidden = False Do Until Cells(i, 1) = vbNullString If Application.CountIf(Cells(i, 2).Resize(, 9), 0) = 9 Then If Hide_range Is Nothing Then Set Hide_range = Cells(i, 1) Else Set Hide_range = Union(Hide_range, Cells(i, 1)) End If End If i = i + 1 Loop If Not Hide_range Is Nothing Then Hide_range.EntireRow.Hidden = True End If End Sub '+++++++++++++++++ Sub show_all_rows() Range("A5").CurrentRegion.EntireRow.Hidden = False End Sub

اعمل استعلام تحديث للحقل A ، واعمل المعايير المطلوبه للاستعلام ، في التحديث ، استعمل: not [A] جعفر

الله يرضى عنك وعن والديك ويجعله فى ميزان حسناتك تسلم يمينك والف الف شكر هذا هو المطلوب انت رائع استاذ سليم عند العمل على الشت جعلنى انبهر من اداءك وتحقيق المطلوب

لا أعلم بالضبط اذا كان هذا المطلوب Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.EnableEvents = False Dim RG As Range Dim i%, x%, lr% lr = Cells(Rows.Count, 1).End(3).Row If lr < 6 Then lr = 12 x = Cells(5, Columns.Count).End(1).Column Range("d5").Resize(lr - 1, x - 3).Interior.ColorIndex = xlNone Set RG = Range("d5").Resize(, x - 3) If Not Intersect(Target, RG) Is Nothing And Target.Count = 1 Then Target.Resize(lr - 1).Interior.ColorIndex = 6 End If Application.EnableEvents = True End Sub '+++++++++++++++++++++++++++++++ Sub MERGE_CELLS() Dim RG As Range Dim i%, x%, t%, lr% Application.ScreenUpdating = False Unmge lr = Cells(Rows.Count, 1).End(3).Row If lr < 6 Then lr = 12 x = Cells(5, Columns.Count).End(1).Column Cells(4, 4).Resize(lr, x).Borders.LineStyle = 1 Set RG = Cells(4, 4) For i = 4 To x If Month(Cells(5, i)) = Month(Cells(5, i + 1)) Then Set RG = Union(RG, RG.Offset(, 1)) RG.Merge Else Set RG = Cells(4, i + 1) End If RG = " شهر:" & Month(Cells(5, i)) Next Cells(4, x + 1).Resize(lr, 20).Clear For i = 4 To x If Cells(4, i).MergeCells Then t = Cells(4, i).MergeArea.Columns.Count Cells(4, i).Resize(lr, t).BorderAround 1, 3 i = i + t - 1 End If Next Cells(4, 4).Resize(, x - 3).BorderAround 1, 3 Application.ScreenUpdating = True End Sub '+++++++++++++++ Sub Unmge() Dim x%, Ro% Ro = Cells(Rows.Count, 1).End(3).Row If Ro < 6 Then Ro = 12 x = Cells(5, Columns.Count).End(1).Column Application.DisplayAlerts = False With Range("d4").Resize(Ro, x) .UnMerge .Rows(1) = vbNullString .Borders.LineStyle = 1 End With Application.DisplayAlerts = True End Sub الملف مرفق من جديد New_merge_Fouzi.xlsm

نعم من خلال group and sort من وضع التصميم

جرب هذا الشيء Hayatmi.xlsb

تفضل بعد اذن الأستاذ سليم طبعاً يمكنك عملها بنفسك بهذه المعادلة =SUMIFS('1'!$D$4:$D$270,'1'!$B$4:$B$270,">="&$F$5,'1'!$B$4:$B$270,"<="&$H$5,'1'!$C$4:$C$270,$B7,'1'!$A$4:$A$270,$D$6)

تفضل 🙂 . =IIf([Rslt]=0,"لا يوجد رصيد",IIf([Rslt]>0,"مدين","دائن")) جعفر

أذهلتنا يا طيب بإنجازاتك المفيدة ربنا يبارك لكم في أعمالكم دمتم بخير

الحمد لله ذي الرضا المرغوب، يعفو ويصفح ويغفر الذنوب... يملي ويمهل لعل العاصي يتوب، يعطي ويرضى ويحقق المطلوب... يُطعم ويَسقي ويستر العيوب، يغني ويشفي ويكشف الكروب... نحمده تبارك وتعالى حمدًا هو للذات العليا منسوب... ونعوذ بنور وجهه الكريم من شر الوسواس الكذوب... ونسأله السلامة فيما مضى وما سوف يأتي من خطوب... اما بعد موضوعنا هذا الشهر يشغل بال الكثيرين الذين يلجؤون للاقتراض التمويلي لشراء منزل او سيارة او اقامة مشروع ما ، وما يترتب علي هذا القرض من فوائد وبدون الخوض في الناحية الشرعية سوف نتاول كيفية حساب القرض الفائدة المركبة هي إحدى طُرُق احتساب الفوائد البنكية على القروض، وحيث أن الفائدة هي مقدار الزيادة على أصل المبلغ على أساسٍ سنوي، فإن الفائدة المركبة هي تركيب للفائدة وزيادة قيمتها – وليس نسبتها – على أصل القرض في كل سنةٍ من عمر القرض. وبما أن عوائد الفوائد هي المصدر الرئيسي لإيرادات البنوك في شتى بلاد العالم؛ فإنه يتم اتِّباع طريقة الفائدة المركَّبة على القروض وليس على الودائع؛ حتى يستفيد البنك من مقدار الفرق الهائل بين ما يدفعُه من فوائد للودائع للعملاء؛ وبين ما يأخذُه على القروض من فوائد. إجمالي المبلغ النهائي مع الفوائد يساوي أصل المبلغ مضروبا ب 1+معدل الفائدة مرفوعاً لعدد الفترات الزمنية. مثال : اقترض أحد الأعضاء من بنك أوفيسنا التجاري مبلغا وقدره 1000 وحدة نقدية بفائدة سنوية 10% لثلاث سنوات. يصبح المبلغ بنهاية المدة 1000 × ( 1.10 ^3 ) = 1000 × 1.331 = 1331 وبذلك تكون الفائدة المركبة بعد 3 سنوات 331 وحدة نقدية في حال كانت الفائدة بسيطة تكون قيمتها بعد 3 سنوات 300 فقط حيث تحسب على أصل المبلغ فقط دون اعتبار الفوائد المتراكمة ولحساب قيمة القرض باستخدام الدالة PMT =PMT(a,n,p) حيث a هي قيمة الفائدة (المتراكمة) في الفترة ، في هذه الحالة هنا الشهر n هي عدد الأقساط المتساوية ، في هذه الحالة هنا 36 p هي قيمة القرض ويوجد شروحات علي المنتدي لشرح الدالة بالتفصيل وشرح القيمة الحالية للفوائد المتراكمة . تسهيلا للبعض اعددت فورم بسيط يقوم بحساب القرض والفائدة المتناقصة (( وبدون الخوض في الأحكام الشرعية المتعلقة بالقروض )) شرح الفورم .... (1920x1080) اضبط تباين الشاشة على loan_calculator2.xls loan calculatorV1-2019.xls

ارجع Borders.LineStyle = xlNo الى 1 أضف الى الكود هذا السطر في المكان المناسب (حسب الصورة)

عليكم السلام إن شاء الله شكرا لك ابوخليل الله يحفظك أخي الكريم husamwahab شكرا جزيلا لك الله يجزاك خير ويعطيك العافية أخي الكريم obaid70 شكرا جزيلا لك

استبدل في هذا السطر الرقم 1 بـــ xlNo .Borders.LineStyle = 1

تفضل 🙂 التقرير مبني على اساس الاستعلام qry_Group ، والذي يمكنك وضع المعايير فيه ، هكذا التقرير قي وضع التصميم : . وعلى حسب العرض المتوفر ، نعمل عدد الاعمدة : . والنتيجة : . جعفر 1290.السجل.accdb.zip

وهذه محاولة باضافة استعلام واحد فقط ارجو ان تكون ناجحة من بعد اذن استاذنا husamwahab المحترم 2moh-212.accdb

تفضل هذه المحاولة moh-313.rar

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

خلاص بفى احر مناقشة بهذا الموضوع الكود بعد التعديل Option Explicit Dim i%, Max_ro%, K%, m%, All_rows% Dim J As Worksheet Dim Spes_sh As Worksheet Dim D1 As Date, D2 As Date Dim x As Boolean '+++++++++++++++++++++++++++++++++++ Sub Fil_data() Application.ScreenUpdating = False Dim t%, cont%, n% m = 5: t = 5 Set J = Sheets("Justify") All_rows = J.Cells(Rows.Count, 1).End(3).Row If All_rows > 4 Then J.Range("A5:O" & All_rows + 5).Clear End If If Not IsDate(J.Range("B2")) Or Not IsDate(J.Range("C2")) Then MsgBox "Type Please a reel date in B2 and C2" GoTo Buy_Buy_Ya_Helween End If D1 = Application.Min(J.Range("B2"), J.Range("C2")) D2 = Application.Max(J.Range("B2"), J.Range("C2")) J.Range("B2") = D1: J.Range("C2") = D2 For Each Spes_sh In Sheets If Spes_sh.Name = "Tarhil" Or Spes_sh.Name = "Justify" Then Else Max_ro = Spes_sh.Cells(Rows.Count, 2).End(3).Row If Max_ro = 1 Then GoTo Next_SHeeet For K = 2 To Max_ro If Spes_sh.Cells(K, 1) <= D2 _ And Spes_sh.Cells(K, 1) >= D1 Then J.Cells(m, 2).Resize(, 14).Value = _ Spes_sh.Cells(K, 3).Resize(, 14).Value If Not x Then J.Cells(m, 1) = Spes_sh.Name End If x = True m = m + 1 End If Next K End If x = False Next_SHeeet: If Spes_sh.Name = "Tarhil" Or _ Spes_sh.Name = "Justify" Then Else J.Cells(m, 1) = "Sum" J.Cells(m, 2).Resize(, 14).Formula = _ "=SUM(B" & t & ":B" & m - 1 & ")" m = m + 1 t = m End If x = False Next Spes_sh If m > 5 Then For cont = 5 To m - 1 If J.Cells(cont, 1) = "Sum" Then J.Cells(cont, 1).Resize(, 15). _ Interior.ColorIndex = 35 End If Next cont J.Cells(m, 1) = "Sum Of ALL" J.Cells(m, 2).Resize(, 14).Formula = _ "=SUM(B5:B" & m - 1 & ")/2" J.Cells(m, 1).Resize(, 15).Interior.ColorIndex = 40 With J.Cells(5, 1).Resize(m - 4, 15) .HorizontalAlignment = xlCenter .Borders.LineStyle = 1: .Font.Size = 14 .Font.Bold = True .Value = .Value .InsertIndent 1 End With End If Buy_Buy_Ya_Helween: Application.ScreenUpdating = True End Sub الملف مرفق Om_Hamz_Super.xlsm

تفضل لك ما طلبت ... وذلك لوجود مسافات زائدة بالمعادلة , تم حذفها ,ورجاءاً لابد ان تكون نهايات فورمات الملف XLSX وليس XLS محمد4.xlsx

التقريب للأعلى =CEILING(SUM($L7,$K7/100)*$M$5,0.1) التقريب للاسفل =FLOOR(SUM($L7,$K7/100)*$M$5,0.1) Samah.xlsb

جرب هذا الملف قبل تنفيذ الماكرو شاهد رؤوس الجداول في الصفحتين الثانية والثالثة و بعد تنفيذه ترى كيف اصبحت اصغط على الزر Run 1-يتم ترتيب البيانات حسب الجدول في الصفجة الأولى 2-يدرج الجدول القديم في الخلية I3 Échelles aléatoires.xlsm

بارك الله فيك وجزاك خيرا اخي ابو أدهم

الاخ وليد ابو عمر Run.Cmd وجدن لك من النت ملف باتش ( سكريبت ) يقوم بمهمة الدمج في ملف جديد يسمي combined.csv يوصع في فلدر ملفات csv نفذ الملف وانتظر قليلا ستجد ملف بأسم combined.csv في نفس الفلدر Report.rar

حاولت التعديل على هذا الكود بدلا من استعلام الحاق DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE TableItem SET TableItem.Selc = -1;" Forms![Form_StorPri]![Form_StorExchSubform]![ItimeCode] = Me![ItimeCode] Forms![Form_StorPri]![Form_StorExchSubform]![NameItemIn] = Me![NameItem] Forms![Form_StorPri]![Form_StorExchSubform]![UnetIn] = Me![Unet] Forms![Form_StorPri]![Form_StorExchSubform]![A-NoIn] = Me![A-No] Forms![Form_StorPri]![Form_StorExchSubform]![QtyIn] = Me![Qty] Forms![Form_StorPri]![Form_StorExchSubform]![PraicIn] = Me![Praic] Forms![Form_StorPri]![Form_StorExchSubform]![TotalIn] = Me![Total] DoCmd.OpenQuery "Query1" DoCmd.SetWarnings True Me.Requery DoCmd.Close ولكن لم يفلح معي