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

شريط الصيغة يعطي القيمة الحقيقية للخلية (بدون ماكياج الذي هو تنسيق الخلايا) لأن تنسيق الخلايا هو فقظ قتاع او (كمّامة ترتديها الخلية) لا تحميها من كورونا الذي هو شريط الصيغة ومهما فعلت لا يمكنك اقتاعه بعدم فضح اسرار الخلية الّا اذا أخفيته فهو مثل نسوان هذه الايام تستطيع الاحتفاظ بالسر حتى أوّل هاتف

بارك الله فيكم وفى جهودكم جميعاً كلها حلول ممتازة

الكود بشكل محتصر أكثر Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.DisplayFormulaBar = _ Intersect(Target, Range("b2:b10")) Is Nothing End Sub

بعد اذن الأستاذ سـلـيم وزيادة فى اثراء الموضوع بدون اخفاء شريط الصيغة ... يمكنك وضع هذا الكود فى حدث الصفحة Dim xDic As New Dictionary Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim xCell As Range Dim xRg As Range Set xRg = Range("b2:b100") If xDic.Count <> xRg.Count Then For Each xCell In xRg xDic.Add xCell.Address, xCell.FormulaR1C1 Next End If If (Target.Count = 1) And (Not Application.Intersect(xRg, Target) Is Nothing) And (Target.HasFormula) Then With Target .Value = .Value End With Else For Each xCell In xRg xCell.Formula = xDic.Item(xCell.Address) Next End If End Sub

جرب هذا الكود (مع تعديله الى النطاق الذي نريده) Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.ScreenUpdating = False Application.EnableEvents = False If Not Intersect(Target, Range("A2:A10")) Is Nothing Then Application.DisplayFormulaBar = False Else Application.DisplayFormulaBar = True End If Application.EnableEvents = True Application.ScreenUpdating = True End Sub

وعليكم السلام -كان عليك استخدام خاصية البحث بالمنتدى فبه طلبك-تفضل كود طباعة الشهادات جميعها واخر لعدد محدد من الشهادات طباعة الشهادات كلها بأمر واحد

السلام عليكم 🙂 عندنا تقرير بهذه الطريقة : . ونريد نعملة بهذه الطريقة : . نعمل التقرير ، ثم نعمل مجاميع لأي من الحقول ، ثم نعمل حقل ليحسب عدد السجلات للمجموعة : . ويجب عمل برواز الحقول شفاف : ---------------------------------------------------------------------- التعديل - 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

تم معالجة الأمر 1- الـشيت Salim هي مثال لما يفوم به الماكرو Do it ( الـشيت Salim هي نسخة طبق الأصل عن الشيت 1999 ) للتجربة فقط تم ادراج هذه الصفحة حفاظاً على البيانات الاساسية لأنه في حال كان المطلوب غير ذلك لا تتأثر البيانات الاساسية في الشيت 1999 (لا يمكن التراجع عما يفعله اي ماكرو بواسطة الأمر Undo ) الكود Option Explicit Dim ro As Long Dim i As Long Sub Do_it() Remove_Minus Remove_Similar End Sub '++++++++++++++++++++++ Sub Remove_Minus() With Sheets("salim") ro = .Cells(Rows.Count, "M").End(3).Row For i = 2 To ro If IsNumeric(Cells(i, "M")) Then Cells(i, "M") = Abs(Cells(i, "M")) End If Next End With End Sub '++++++++++++++++++++++++ Sub Remove_Similar() Sheets("salim").Range("A1").CurrentRegion.RemoveDuplicates _ Columns:=Array(4, 5, 11, 13), Header:=1 End Sub الملف مرفق Remove_Dup.xlsm

وعليكم السلام 🙂 اما انا ، فكنت سأتعامل مع الموضوع كما بالرابط التالي: . طبعا هذا فقط للتوضيح ، والكلام عن ايقونات الملفات التي في الجزء اليمين من الصورة : جعفر

تماما كما مطلوب الله يعافيك ..شكرا شكرا

تمام

ممنون منك استاذ الف الف شكر 😘

هلا والله ، الحمدلله قدرنا نرضي زبون نشط 🙂 جعفر

الحمدلله 🙂 1. اذا الارقام في اعدادات الكائن فيه cm (ما اعرف بالاكسس العربي شو يكتب!! ) فانت بالسنتيمتر ، واذا فيه " فانتبنظام البوصة ، او انظر الى اعدادات النظام : . 2. مالك شغل في الجهاز الآخر ، اشتغل على نظام جهازك ، والاكسس تلقائيا يغيره لأي نظام آخر 🙂 هذا نظامي: . مثال ، اريد ان اضع التقرير الفرعي هنا : . فاستعملت حدث الزر امر3 : . والنتيجة : . تفضل انت ، افتح المرفق وانقر على الزر واخبرنا النتيجة 🙂 جعفر 1295.mov.accdb.zip

الموضوع سهل جدا اخى اعمل LINK لكل نموذج

شكرا جزيلا هو دة المطلوب بالفعل ربنا يجعله فى ميزان حسناتك

استدل كود الوحدة النمطية بالاتى Public Function Horizontal(tabelle As String, Feld1 As String, Feld2 As String, valFeld1) Dim DB Dim rs As Recordset Set DB = CurrentDb Set rs = DB.OpenRecordset("select distinct " & Feld2 & " from " & tabelle _ & " where " & Feld1 & "='" & valFeld1 & "' order by " & Feld2) Do If rs.AbsolutePosition = rs.BOF Then Horizontal = Format(rs(Feld2), "yyyy/mm/dd") Else Horizontal = Horizontal & " - " & Format(rs(Feld2), "yyyy/mm/dd") End If rs.MoveNext Loop Until rs.EOF rs.Close DB.Close Set rs = Nothing Set DB = Nothing End Function

يعنى الصح 2019-07-01 ام هذا 01-07-2019

وعليكم السلام 🙂 النموذج الفرعي ، مثله مثل اي كائن آخر في النموذج مثل حقول النص والتسميات والازرار وووو ، يمكن التعامل في مكانهم وحجمهم كالتالي (على فرض ان اسم الكائن A) : من فوق me.A.Top = 12 من اليسار me.A.Left = 2 العرض me.A.width = 45 الارتفاع me.A.Height = 15 . . جعفر

بعد اذن الاخ ابراهيم هذا الكود Option Explicit Sub Multi_Sum() Dim LR%, t%, m% With Sheets("Sheet1") LR = .Range("A" & Rows.Count).End(xlUp).Row For t = 1 To LR If Application.CountA(.Cells(t, 1).Resize(, 2)) = 1 Then .Cells(t, 1) = vbNullString End If Next m = .Range("A1", Range("A1").End(4)).Rows.Count t = 1 Do Until t > LR With .Range("A" & t + m) .Formula = _ "=SUM(A" & t & ":B" & t + m - 1 & ")" .Value = .Value End With t = t + m + 2 Loop End With End Sub الملف مرفق ahmed sherif.xlsm

السلام عليكم ورحمة الله استخدم هذا الكود Sub Suming() Dim LR As Long, i As Long, j As Integer, p As Integer Dim ws As Worksheet Set ws = Sheets("Sheet1") LR = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 MsgBox LR i = 6 j = i - 5 p = i - 1 Do While i <= LR ws.Range("A" & i).Value = WorksheetFunction.Sum(ws.Range("A" & j & ":B" & p)) i = i + 7 Loop End Sub

مرفق التعديل على معادلة العمود P لكن معادلة العمود R غير واضحة (مع أني فهمت الاشكال الذي طرحته بأنه يجب أن لا يكون هناك مدة ما دام تاريخ الحساب قبل تاريخ البداية) وضح فكرة المعادلة كاملة في العمود R برنامج فحص.xlsm

السلام عليكم 🙂 شكرا لكم جميعا 🙂 اخي اباجودي ، شكر خاص لك على هذا الدلال والدلع ، ومش عرف ان بتجيب الكلمات دي منين 🙂 عملت تعديل في المرفق ، واصبح الآن يأخذ اطوال مختلفة من السجلات 🙂 جعفر

بعد اذن اخي المهندس هذا الملف بتنسيقات مختلفة وبدون التعداد الزائد (1 /2 / 3 الخ....) Canionettes.xls

مرفق المطلوب وبالتوفيق تشغيل الشاحنات.xls

جزاك الله خيرا ً ...

وعليكم السلام 🙂 الاستعلام qry_1 يأخذ جميع بيانات الجداول (مثل بقية استعلاماتك ، ولكن بدون اي معيار) ، والاستعلام qry_Group ، فيقسم البيانات الى مجموعات ، ثم يحسب مجموع قيمة مبلغ كل قسم ، ولا يحسب ترتيب مجموع الدائن والمدين والصافي ، لأننا نقوم بجمعه في هذا الاستعلام (أ. لأني ما ادري كيف قمت انت بعمل حسبة الدائن والمدين والصافي ، ب. لأن احد هذه القيم لم تكن في الجدول ، فقمت بعملية الحسبة احتياطا 🙂 ) . وتقدر تضع معيار التاريخ ، ورقم الملف في هذا الاستعلام ، وباقي العمل يقوم به التقرير ، وفيه مجموع الدائن والمدين والصافي 🙂 جعفر

تفضل اخوي العزيز .. البيانات في صفحة data والورقة الاخرى .. اختار الصف المراد .. لتغيير الاسماء .. ان شاء الله ان يكون المطلوب .. اكسل الصف والشعبة.xlsx

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

الحمد لله ذي الرضا المرغوب، يعفو ويصفح ويغفر الذنوب... يملي ويمهل لعل العاصي يتوب، يعطي ويرضى ويحقق المطلوب... يُطعم ويَسقي ويستر العيوب، يغني ويشفي ويكشف الكروب... نحمده تبارك وتعالى حمدًا هو للذات العليا منسوب... ونعوذ بنور وجهه الكريم من شر الوسواس الكذوب... ونسأله السلامة فيما مضى وما سوف يأتي من خطوب... اما بعد موضوعنا هذا الشهر يشغل بال الكثيرين الذين يلجؤون للاقتراض التمويلي لشراء منزل او سيارة او اقامة مشروع ما ، وما يترتب علي هذا القرض من فوائد وبدون الخوض في الناحية الشرعية سوف نتاول كيفية حساب القرض الفائدة المركبة هي إحدى طُرُق احتساب الفوائد البنكية على القروض، وحيث أن الفائدة هي مقدار الزيادة على أصل المبلغ على أساسٍ سنوي، فإن الفائدة المركبة هي تركيب للفائدة وزيادة قيمتها – وليس نسبتها – على أصل القرض في كل سنةٍ من عمر القرض. وبما أن عوائد الفوائد هي المصدر الرئيسي لإيرادات البنوك في شتى بلاد العالم؛ فإنه يتم اتِّباع طريقة الفائدة المركَّبة على القروض وليس على الودائع؛ حتى يستفيد البنك من مقدار الفرق الهائل بين ما يدفعُه من فوائد للودائع للعملاء؛ وبين ما يأخذُه على القروض من فوائد. إجمالي المبلغ النهائي مع الفوائد يساوي أصل المبلغ مضروبا ب 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

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

جزاك الله خيرا اخى ومعلمنا العزيز @jjafferr جعله الله فى ميزان حسناتك انا استخدمت على ويندوز 7 - 32 بت اوفيس 2003 و 2016 - 32 بت وحقا طريقة رائعة جدا جزاك الله خيرا أخى شيفان بالتوفيق

بارك الله فيك استاذ سليم وبعد اذن حضرتك ولإثراء الموضوع -يمكن أيضاً استخدام هذه المعادلة بداية من الخلية N3 سحباً يساراً وأسفل =COUNTIFS($H$3:$H$500,"<="&$M3,$H$3:$H$500,">="&$L3,$I$3:$I$500,N$2) Countifs,معادلة احصاء عدد الذكور والإناث بين تاريخين.xlsx

في الخلية (N3) هذه المعادلة واسجب عامودين و 7 أعمدة =SUMPRODUCT(--($H$3:$H$53<>""),--($H$3:$H$53<=$M3),--($H$3:$H$53>=$L3),--($I$3:$I$53=N$2)) الملف مرفق Mustafa.xlsx

وعليكم السلام-تفضل ما تريد بالتنسيقات الشرطية. وتم ايضاً لعمل قائمة منسدلة لإختيار الحروف المطلوبة نظام التقييم للصف االاول بالألوان1.xlsx

وعليكم السلام-تفضل وذلك بإستخدام هذه المعادلة =IF(F3=TODAY()-7,TEXT(F3,"b2dddd")&" , "&"الماضى "&"("&TEXT(F3,"d ")&VLOOKUP(MONTH(F3),$M$3:$N$14,2,0)&")",IF(F3=TODAY()-1,TEXT(F3,"b2dddd")&" , "&"أمس "&"("&TEXT(F3,"d ")&VLOOKUP(MONTH(F3),$M$3:$N$14,2,0)&")",IF(F3=TODAY(),TEXT(F3,"b2dddd")&" , "&"اليوم "&"("&TEXT(F3,"d ")&VLOOKUP(MONTH(F3),$M$3:$N$14,2,0)&")",IF(F3=TODAY()+1,TEXT(F3,"b2dddd")&" , "&"غداً "&"("&TEXT(F3,"d ") & VLOOKUP(MONTH(F3),$M$3:$N$14,2,0)&")",IF(F3=TODAY()+7,TEXT(F3,"b2dddd")&" , "&"القادم "&"("&TEXT(F3,"d ")&VLOOKUP(MONTH(F3),$M$3:$N$14,2,0)&")",""))))) 2.xlsx

تم عمل المطلوب كما تريدين Option Explicit Dim i%, Max_ro%, m% Dim J As Worksheet Dim ro%, col%, my_sum# Dim Spes_sh As Worksheet Dim D1 As Date, D2 As Date '+++++++++++++++++++++++++++++++++++ Sub Fil_data_All() Application.ScreenUpdating = False Set J = Sheets("Justify") J.Range("A5:L5000").Clear If Not IsDate(J.Range("B2")) Or Not IsDate(J.Range("C2")) Then MsgBox "Type Please a reel date in B2 and C2" Exit Sub 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 Spes_sh.Range("A2").Resize(Max_ro - 1, 11) _ .Interior.ColorIndex = 35 For col = 3 To 11 my_sum = 0 For ro = 2 To Max_ro If Spes_sh.Cells(ro, 1) <= D2 And _ Spes_sh.Cells(ro, 1) >= D1 Then Spes_sh.Cells(ro, 1).Interior.ColorIndex = 40 Spes_sh.Cells(ro, col).Interior.ColorIndex = 40 my_sum = my_sum + Val(Spes_sh.Cells(ro, col)) End If Next ro ro = J.Cells(Rows.Count, "j").End(3).Row m = IIf(ro = 3, 5, ro + 1) J.Cells(m, col - 1) = my_sum J.Cells(m, 1) = Spes_sh.Name Next col End If Next Spes_sh If m > 5 Then J.Cells(m + 1, 1) = "SUM" J.Cells(m + 1, 2).Resize(, 9).Formula = _ "=SUM(B5:B" & m & ")" J.Cells(5, "J").Resize(m - 4).Formula = _ "=SUM(B5:I5)" With J.Cells(5, 1).Resize(m - 3, 10) .HorizontalAlignment = xlCenter .Borders.LineStyle = 1: .Font.Size = 14 .Font.Bold = True .Value = .Value .InsertIndent 1 End With J.Cells(m + 1, 1).Resize(, 10).Interior.ColorIndex = 40 End If Application.ScreenUpdating = True End Sub الملف مرفق (الكود القديم ما زال يعمل اذا كانت هناك حاجة اليه) Om_Hamz_Matloub.xlsm

تم معالجة الأمر البيانات المكررة في اي شيت يقوم الماكرو بادراحها مرة واحدة فقط بمعنى اخر لو تم الضغط على الزر اكثر من مرة (دون التعديل في البيانات Tarhil) لا تتكرر البيانات Option Explicit Dim i%, Max_ro%, K%, m% Dim J As Worksheet Dim Spes_sh As Worksheet Dim D1 As Date, D2 As Date '+++++++++++++++++++++++++++++++++++ Sub Fil_data() Set J = Sheets("Justify") J.Range("A5").CurrentRegion.Clear If Not IsDate(J.Range("B2")) Or Not IsDate(J.Range("C2")) Then MsgBox "Type Please a reel date in B2 and C2" Exit Sub 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 m = 5 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, 1) = m - 4 J.Cells(m, 2).Resize(, 11).Value = _ Spes_sh.Cells(K, 1).Resize(, 11).Value m = m + 1 End If Next K End If Next_SHeeet: Next Spes_sh If m > 5 Then With J.Cells(5, 1).Resize(m - 5, 12) .HorizontalAlignment = xlCenter .Borders.LineStyle = 1: .Font.Size = 14 .Font.Bold = True .Value = .Value .InsertIndent 1 End With End If End Sub الملف من جديد OM_HAMZA_SHEETS_NEW.xlsm

السلام عليكم ورحمة الله وبركاته اتمنى ان شاء الله أن افيد هذا الصرح المبارك كما افادني كثير ♥ https://youtu.be/5sTIMR0MVc0 ملف العمل.xlsx

1-تصغير الملف الى 20 - 40 اسم لا أكثر تختار الأرقام من الخليتين B1 و B2 (في حال الخطأ الماكرو ياخذ الأرقام من 1 الى عدد الطلاب) 2- في حال تريد طالباً واحداَ تكرر رقمه في B1 و B2 مثلاً نريد الطالب رقم 5 نضع 5=B1 و 5=B2 يوجد صفحة مخفية لادراج الجداول (عدم المس بها لحسن سير عمل الماكرو) جرب خذا الملف Dim Mn%, Mx%, LR, k%, t%, i% Dim ValA, ValB Dim xx1%, xx2% '++++++++++++++++++++++++++++++++ Rem Created By Salim Hasbaya On 20/11/2020 Sub CopY_rg(rg As Range, Where%) rg.Copy Saf.Range("A" & Where).PasteSpecial (xlPasteAll) Application.CutCopyMode = False End Sub '++++++++++++++++++++++++++++++++ Sub fil_Rg() Rem Created By Salim Hasbaya On 20/11/2020 LR = Fat.Cells(Rows.Count, 3).End(3).Row If LR < 10 Then Exit Sub xx1 = Val(Fat.Range("B1")) xx2 = Val(Fat.Range("B2")) ValA = IIf(xx1 <= 0, 1, Int(xx1)) ValB = IIf(xx2 <= 0, LR - 9, Int(xx2)) If ValA > LR - 9 Then ValA = 1 If ValB > LR - 9 Then ValB = LR - 9 Mn = Application.Min(ValA, ValB) Mx = Application.Max(ValA, ValB) Fat.Range("B1") = Mn: Fat.Range("B2") = Mx t = Fat.Range("B2") - Fat.Range("B1") + 1 k = 1 Saf.Cells.Clear For i = 1 To t Call CopY_rg(Source.Range("SPES_RG"), k) k = k + 18 Next Saf.Rows.AutoFit End Sub '++++++++++++++++++++++++++++++++++ Sub Get_certificates() Rem Created By Salim Hasbaya On 20/11/2020 fil_Rg Dim Ro1%, Ro2%, Pos% Dim y%, n% Dim A1, A2, A3 A1 = Application.Transpose(Source.Range("Q1:AA1")) A1 = Application.Transpose(A1) A2 = Application.Transpose(Source.Range("Q2:AA2")) A2 = Application.Transpose(A2) A3 = Application.Transpose(Source.Range("Q3:AA3")) A3 = Application.Transpose(A3) Pos = 8 Ro1 = Fat.Range("B1") + 9 Ro2 = Fat.Range("B2") + 9 For y = Ro1 To Ro2 Saf.Cells(Pos - 6, 3) = Fat.Cells(y, 3) For n = LBound(A1) To UBound(A1) If Saf.Cells(Pos, 1) = "" Then Exit For Saf.Cells(Pos, 3).Offset(, n - 1) = _ Fat.Cells(y, A1(n)) Saf.Cells(Pos, 3).Offset(1, n - 1) = _ Fat.Cells(y, A2(n)) Saf.Cells(Pos, 3).Offset(2, n - 1) = _ Fat.Cells(y, A3(n)) Next n Pos = Pos + 18 Next y Saf.PageSetup.PrintArea = Saf.Range("a1") _ .Resize(Pos - 10, 14).Address End Sub Khiri.xlsm

السلام عليكم ورحمة الله ضع المعادلة التالية قى الخلية "" =COUNTIFS($B$3:$B$5000;"السادس ";$C$3:$C$5000;$G3;$D$3:$D$5000;"أ") اما المعادلة التالية فضعها فى الخلية "" =COUNTIFS($B$3:$B$5000;"السادس ";$C$3:$C$5000;$G3;$D$3:$D$5000;"ب") ثم اسحب المعادلتين الى اخر خلية تريدها قم بتغيير اسم الصف فى كل جدول هذا و بالله التوفيق عفوا الخلية الاولى " H3 " و الخلية الثانية " I3 " حساب أعداد الطلاب حسب ثلاث قيم.xlsx

وعليكم السلام - تفضل اخى الكريم يمكنك عمل ذلك بهذه المعادلة ( معادلة مصفوفة) Ctrl+Shift+Enter =IF(COUNTIF($A$3:$A3,$A3)>1,"",MODE(IF($A$3:$A$900=$A3,$F$3:$F$900))) mode fun1.xlsx

دائماً وأبداً ممنوع دمج الخلايا حيث توجد معادلات (الصفوف 7/ 8 / 9) Yaser_W.xlsm

هاي يسمونها الخبرة 🙂 جعفر

الاستاذ @jjafferr yes "Because I spent hours trying to solve the problem and then you come and tell me that the solution is in the word "parent

السلام عليكم قمت -بتحفظ- بما تطلبه في الملف... بن علية حاجي 2ملف.rar

الملف مع المعادلة salimالتاريخ الافتراضي.rar

السلام عليكم ورحمة الله اكتب الكود التالى واربطه بالزر الموجود بالملف Sub Sorting() Range("A2:S" & Range("D" & Rows.Count).End(xlUp).Row).Sort key1:=Range("K2"), order1:=xlAscending End Sub

السلام عليكم ورحمة الله وبركاته اخوانى الأفاضل هذا الموضوع أرسله لي أحد الإخوة (رجب محمد مرسي) وأحببت أن يشارك فيه من أراد ومن له مشكلة مماثلة يسأل أخونا قائلا =================================================== انا جديد في التعامل مع اكسل فلا اسطيع التعامل بشكل مناسب مع اكواد ومعادلات اكسل .. ولله الحمد انا اعرف عمل كود طباعة شهادة ةاحدة وذلك من خلال record macro هل يمكن طباعة جميع الشهادات عن طريق record macro ام لابد من كتابة الماكرو وهذ ما لا اعرفة لانة يحتاج الى vba الرجاء شرح خطوة خطوة في كيفية عمل ذلك عن طريق record macro او اي شئ يكون مفيد بعيدا عن الاكواد ووجع الاكواد ======================================================== وردا عليه أقول نحتاج أخي في هذه الحالة إلي كود بسيط من 5 أسطر فقط وستجد بالمرفق ماتريد مع شيت بآخر الملف به شرح الكود تفضل المرفق شيت كنترول2.zip

السلام على من اتبع الهدى و بعد لحل المشكلة ان شاء الله 1- أغلق كافة تطبيقات الأوفيس 2- اذهب الى Control Panel و اختار Add or Remove Programs أو Programs and Features فى Windows Vista or Windows 7 3- حدد الخيار Microsoft Office ثم اضغط مفتاح Change 4- اختار add or remove features 5- حدد Visual Basic for Applications و أعمل لها تنصيب من الكمبيوتر Run from My Computer و اضغط استمرار continue ان شاء الله المشكلة تتحل و اليك صور مساعدة دمت بخير و أعزك الله .