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

السلام عليكم ورحمة الله وبركاته مرحبا بكم اعزائي و ضيوفي الكرام في هذا المنتدى العظيم ونهاركم سعيد اليوم هناك درس جميل وبسيط جدا لأن أنا شخصيا أحب تبسيط الأمور حتى تسهل على اخواني الكرام. نموذج فاتورة يساعدك على اعداد فاتورتك بسرعة باستخدام مايكروسفت اكسل وتشمل المحموع و المجموع الفرعي و الضرائب وضريبة القيمة المضافة و أيضا خصم و المبلغ المستحق مع الصيغة لحساب المجاميع. ملاحظة : يمكنك مسح البيانات والتعديل عليها المصدر مفتوح. أخوكم في الله مناد سفيان - الجزائر قالب قاتورة بتنسيق اكسل.rar

السلام عليكم ورحمة الله وبركاته مرحبا بكم اعزائي و ضيوفي الكرام في هذا المنتدى العظيم ومرة اخرى سأرفق لكم الملف مفتوح المصدر بسيط وهو ملف يقوم بحساب التواريخ و الأعوام والايام و الأسابيع بشكل مفصل لذا سأترككم مع هذا الملف. أخوكم في الله مناد سفيان - الجزائر الفرق بين التارخيين.rar

السلام عليكم ورحمة الله وبركاته مرحبا بكم اعزائي و ضيوفي الكرام في هذا المنتدى العظيم ومرة اخرى سأرفق لكم الملف مفتوح المصدر بسيط وهو ملف يقوم بحساب التواريخ و الأعوام والايام و الأسابيع بشكل مفصل لذا سأترككم مع هذا الملف. أخوكم في الله مناد سفيان - الجزائر الفرق بين التارخيين.rar

بسم الله والصلاة والسلام على سيدنا محمد عليه الصلاة والسلام أود أن اشكر كل الطاقم وخاصة مدير المنتدى أوفيسينا والأساتذة الكرام فتحية مني لهم اليوم عندي قاعدة بيانات سهلة وهي تستعمل في الجامعات أي للطلاب المستدركين فيالمواد الراسبة حتى لا أطيل عليكم الكلام لأنه لايحتاج الى شرح كبير سوف تجدون المرقف أسفل الرابط أدعووووووو لي فقــــــــــــــــــــــــــــــــــــــــــــــط نتائج إمتحانات السنة الثانية قانون أعمال - 2012-2013.rar

السلام عليكم ورحمة الله وبركاته مرحبا بكم اعزائي و ضيوفي الكرام في هذا المنتدى العظيم اليوم سوف أقدم لكم ملف جميل و هو عبارة عن دوال if هل تعلم لماذا أضفت مشتقاتها لأن لدي دوال من نفس العمل على سبيل المثال كا ان و أخواتها و لهذا قمت بترتيبها حسب المعطيات التي تتوافق مع العمل حتى لا أطيل عليكم الكلام كثيرا أترككم مع هذا الملف البسيط والمتواضع.أخوكم في الله مناد سفيان الجزائر. برنامج القوائم المشروطة.rar

السلام عليكم ورحمة الله وبركاته مرحبا بكم اعزائي و ضيوفي الكرام في هذا المنتدى العظيم اليوم اقدم لكم ملف وبدون اطالة يقوم بضرب العدد اي ضعف العدد على سبيل المثال : 5*5=25 هذا هو غمل الملف. ضع القيمة على سبيل المثل 04 وعندها اضغط على الزر ايجاد ضعف النتيجة انتهى الشرح أخوكم في الله مناد سفيان الجزائر. ضرب القيمة.rar

السلام عليكم ورحمة الله وبركاته بارك الله فيكم ولكم مني الف الف تحية

بسم الله الرحمن الرحيم احبابنا في الله ادعو الله ان تكونوا بخير يارب هذا ملف به كود واحد خاص باخراج شهادات الطلاب وما أسهله يستطيع ان يستجلب ===== كل انواع الشهادات المطلوبه الكود للنابغه ساجده العزاوي من العراق وتعديل المحترم ذائع الصيت بن علية حاجي من الجزائر حفظهم الله ورعاهم طريقه الاستفاده من هذا الملف افتح هذا الملف اضغط على زر ALT وانت ماتزال ضاغطا اضغط على F11 سيتم فتح محرر الاكواد .. ستجد امامك موديولات بها الاكواد دبل كليك على اول موديول ثم اضغط من لوحة المفاتيح على ALT +SHEFT لتكون اللغه هي العربيه منعا لظهور اللغه العربيه بشكل طلاسم اجعل مؤشر الماوس في الكود ثم اضغط CTRL +A لتحديد الكود كله ثم CTRL+C ليتم النسخ ===== ** افتح ملفك وافتح محرر الاكواد كما اشرنا سابقا ** ومن قائمه محرر الاكواد التي فتحت امامك ** اختر Insert واختر منها Module ** ثم ضع المؤشر في Module ** والصق الكود ========== ماهي التغييرات التي تحدثها في الكود حتى يكون صالحا للاستعمال ؟ ** غير اسم صفحه مصدر البيانات ** غير اسم صفحة الشهادات ** غير رقم عمود المعيار ** غير رقم خليه رقم الجلوس لو غيرت موقعها ========= احمد الله وادعو لكل من له بصمه في اخراج هذا العمل بالخير يكفي جملة جزاكم الله خيرا الشهادات ذات الثلاثه معايير في الخليه R1 نكتب بدايه الصف الذي نريد الشهادات منه في الخليه S1 نكتب نهايه الصف الذي نريد الشهادات اليه === و في الخليه R7 نكتب كلمه (نا ) او ( دور ) وفي الخليه S7 نكتب ( ول ) اختصار كلمه ولد او نكتب ( بن ) اختصار كلمه بنت وفي الخليه T7 نكتب الفصل (3/1 ) مثلا وهكذا نكون استطعنا ان نستدعي شهادات الاولاد الناجحين في فصل معين في مدى معين او الاولاد اللي عندهم دور تان في فصل معين او البنات الناجحين في فصل معين او البنات اللي عندهم دور تان في فصل معين وفي مدى معين ************** يكفي جملة جزاكم الله خيرا كود الشهادات المرجع.rar ***************************** وتعديل المحترم ذائع الصيت بن علية حاجي من الجزائر تم بناء على متطلبات جديده في الكود

شيت كنترول للتعليم الفني انتظام وعمال لاكثر من تخصص يستوعب 5 تخصصات انتظام+5تخصصات عمال تم تجريبه بنجاح به توزيع اللجان وارقام الجلوس والشهادات وطباعة الشيت لاعلان النتيجة حمل الملف التالي https://drive.google.com/open?id=0B4Pmwhdlsw6cNkZaYzRGWFZyUW8

Sub ثلاثة_معايير() 'هذا الكود للنابغه ساجده العزاوي ' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه 'تم في اكتوبر 2017 'كمعطيات المحترم ابو أحمد محمدي 'تم التعديل على الكود لمتطلبات جديده بواسطه المحترم ذائع الصيت بن علية حادجي الجزائري 'تم بناء على متطلبات جديده في الكود 'الهدف من الكود هو استخراج الشهادات 'كل 3 شهادات في صفحه واحدة 'بثلاثة معايير '====================== Dim SHEHADA As Worksheet, DATA As Worksheet Dim myArray, targt1, targt2, targt3 As String Dim X, Y, Z, U, V As Long 'اسم صفحة المصدر Set DATA = Worksheets("رصد الترم الثانى") 'اسم صفحة الهدف Set SHEHADA = Worksheets("3 شهادات ب3 معايير") '====================== ' targt1 = "ناج*" ' targt2 = "ول*" ' targt3 = "5/1" targt1 = SHEHADA.Range("R7").Value & "*" targt2 = SHEHADA.Range("S7").Value & "*" targt3 = SHEHADA.Range("T7").Value & "*" '====================== c = 0 Application.ScreenUpdating = False lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row 'اخر صف به بيانات '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! X = SHEHADA.Range("T1").Value Y = SHEHADA.Range("R1").Value Z = SHEHADA.Range("S1").Value U = IIf(X = 1, 7, Y) V = IIf(X = 1, lr, Z) '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 'هذا السطر في حال كل الشهادات أو شهادات محددة For i = U To V '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! If DATA.Cells(i, 101) Like targt1 & "*" _ And DATA.Cells(i, 104) Like targt2 & "*" _ And DATA.Cells(i, 103) Like targt3 & "*" _ And c = 0 Then Range("M3") = DATA.Cells(i, 2) c = c + 1 '====================== ElseIf DATA.Cells(i, 101) Like targt1 & "*" _ And DATA.Cells(i, 104) Like targt2 & "*" _ And DATA.Cells(i, 103) Like targt3 & "*" _ And c = 1 Then Range("M19") = DATA.Cells(i, 2) c = c + 1 '====================== ElseIf DATA.Cells(i, 101) Like targt1 & "*" _ And DATA.Cells(i, 104) Like targt2 & "*" _ And DATA.Cells(i, 103) Like targt3 & "*" _ And c = 2 Then Range("M35") = DATA.Cells(i, 2) c = c + 1 '====================== 'ElseIf DATA.Cells(i, 101) Like targt1 & "*" _ And DATA.Cells(i, 104) Like targt2 & "*" _ And DATA.Cells(i, 103) Like targt3 & "*" _ And c = 3 Then ' SHEHADA.Range("M51") = DATA.Cells(i, 2) ' c = c + 1 '====================== End If '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 'If i = V And c = 4 Then SHEHADA.Range("a1:p63").PrintOut: Exit For If i = V And c = 3 Then SHEHADA.Range("a1:p47").PrintOut: Exit For If i = V And c = 2 Then SHEHADA.Range("a1:p31").PrintOut: Exit For If i = V And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For If i < V And (Range("M19") = "" Or Range("M35") = "") Then GoTo 1 If i < V And c = 3 Then SHEHADA.Range("a1:p47").PrintOut '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! c = 0 SHEHADA.Range("M3") = "" SHEHADA.Range("M19") = "" SHEHADA.Range("M35") = "" ' SHEHADA.Range("M51") = "" 1: Next i SHEHADA.Range("M3") = "" SHEHADA.Range("M19") = "" SHEHADA.Range("M35") = "" ' SHEHADA.Range("M51") = "" Application.ScreenUpdating = True End Sub الهدف من الكود هو استخراج الشهادات 'كل ثلاث 3 شهادات في صفحه واحدة 'بثلاثة معايير

Sub اربعشهادات_بثلاث_معايير() 'هذا الكود للنابغه ساجده العزاوي ' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه 'تم في اكتوبر 2017 'كمعطيات المحترم ابو أحمد محمدي 'تم التعديل على الكود لمتطلبات جديده بواسطه المحترم ذائع الصيت بن علية حادجي الجزائري 'تم بناء على متطلبات جديده في الكود 'الهدف من الكود هو استخراج الشهادات 'كل 3 شهادات في صفحه واحدة 'بثلاثة معايير '====================== Dim SHEHADA As Worksheet, DATA As Worksheet Dim myArray, targt1, targt2, targt3 As String Dim X, Y, Z, U, V As Long 'اسم صفحة المصدر Set DATA = Worksheets("رصد الترم الثانى") 'اسم صفحة الهدف Set SHEHADA = Worksheets("4شهادات بثلاث معايير") '====================== ' targt1 = "ناج*" ' targt2 = "ول*" ' targt3 = "5/1" targt1 = SHEHADA.Range("R7").Value & "*" targt2 = SHEHADA.Range("S7").Value & "*" targt3 = SHEHADA.Range("T7").Value & "*" '====================== c = 0 Application.ScreenUpdating = False lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row 'اخر صف به بيانات '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! X = SHEHADA.Range("T1").Value Y = SHEHADA.Range("R1").Value Z = SHEHADA.Range("S1").Value U = IIf(X = 1, 7, Y) V = IIf(X = 1, lr, Z) '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 'هذا السطر في حال كل الشهادات أو شهادات محددة For i = U To V '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! If DATA.Cells(i, 101) Like targt1 & "*" _ And DATA.Cells(i, 104) Like targt2 & "*" _ And DATA.Cells(i, 103) Like targt3 & "*" _ And c = 0 Then Range("M3") = DATA.Cells(i, 2) c = c + 1 '====================== ElseIf DATA.Cells(i, 101) Like targt1 & "*" _ And DATA.Cells(i, 104) Like targt2 & "*" _ And DATA.Cells(i, 103) Like targt3 & "*" _ And c = 1 Then Range("M19") = DATA.Cells(i, 2) c = c + 1 '====================== ElseIf DATA.Cells(i, 101) Like targt1 & "*" _ And DATA.Cells(i, 104) Like targt2 & "*" _ And DATA.Cells(i, 103) Like targt3 & "*" _ And c = 2 Then Range("M35") = DATA.Cells(i, 2) c = c + 1 '====================== ElseIf DATA.Cells(i, 101) Like targt1 & "*" _ And DATA.Cells(i, 104) Like targt2 & "*" _ And DATA.Cells(i, 103) Like targt3 & "*" _ And c = 3 Then SHEHADA.Range("M51") = DATA.Cells(i, 2) c = c + 1 '====================== End If '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! If i = V And c = 4 Then SHEHADA.Range("a1:p63").PrintOut: Exit For If i = V And c = 3 Then SHEHADA.Range("a1:p47").PrintOut: Exit For If i = V And c = 2 Then SHEHADA.Range("a1:p31").PrintOut: Exit For If i = V And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For If i < V And (Range("M19") = "" Or Range("M35") = "" Or SHEHADA.Range("M51") = "") Then GoTo 1 If i < V And c = 4 Then SHEHADA.Range("a1:P63").PrintOut '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! c = 0 SHEHADA.Range("M3") = "" SHEHADA.Range("M19") = "" SHEHADA.Range("M35") = "" SHEHADA.Range("M51") = "" 1: Next i SHEHADA.Range("M3") = "" SHEHADA.Range("M19") = "" SHEHADA.Range("M35") = "" SHEHADA.Range("M51") = "" Application.ScreenUpdating = True End Sub جزاهم الله كل خير وبارك فيهم يارب .. كل من كانت له بصمه في هذا الملف

اظهار البيانات عند البحث في نموذج مستقل المطلوب اريد عندما ادخل الرقم في مربع النص واضغط على زر البحث تظهر لي البيانات في نموذج مثل التقرير

تم ارفاق الملف تجريبي1.rar

السلام عليكم مرفق الملف بعد التعديلات واظن انه يلبى كل تطلعاتك ويحتوى على الاتى قائمة منسدلة لاختيار رقم الاقرار المطلوب عرضه إفرار جديد لتنظيف النموذج مع اضافة رقم مسلسل جديد رقم حفظ التعديلات ويقوم بحفظ التغييرات على إقرار موجود او اضافة إقرار جديد ويمكنه ايضا عمل رقم للإقرار لو رقمه غير موجود فحص النموذج واخبارك بالمعلومات التى لم يتم ادخالها حسب قائمة الفحص تنظيف النموذج ... مسح جميع البيانات فى النموذج إقرار.rar

السلام عليكم بالنسبة لارتفاع الصفوف وعرض الخلايا : دى عملية من الافضل انك تعملها يدوى اول مرة حسب الطابعة الخاصة بك وابعاد ورق الطباعة ولن تتغير لان الكود لايقترب منها طبعا عدد الصفوف فى كل ورقة عمل انت محدده مسبق اما بالنسبة للسلسلة النصية فيمكن تطبيق الكود التالى بدلا من الموجود مسبقا لتوزيع التوقيعات .Cells(29 * i + 4, 1) = "مراجع أول" & String(25, " ") & "مراجع ثاني" & String(25, " ") & "مراجع ثالث" & String(25, " ") & "مراجع رابع" & String(25, " ") & "مراجع خامس" .Range("A" & 29 * i + 4, "I" & 29 * i + 4).HorizontalAlignment = xlCenterAcrossSelection والكود بالكامل سيصبح كالتالى Option Explicit Sub TransferdataByTwoConditions() Dim LR As Long, x As Long, i As Long, j As Long, z As Long, zz As Long Application.ScreenUpdating = 0 With Sheets("الرئيسية") LR = .Range("A" & Rows.Count).End(xlUp).Row ReDim Arr(1 To LR, 1 To 45) ReDim SS(1 To LR, 1 To 9) ReDim SS2(1 To LR, 1 To 9) Arr = .Range("A8", "AS" & LR).Value Dim WS As Worksheet Set WS = Sheets.Add(After:=Sheets(Worksheets.Count)) WS.Range("A8", "AS" & LR) = Arr WS.Sort.SortFields.Clear WS.Sort.SortFields.Add Key:=Range("D8", "D" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal WS.Sort.SortFields.Add Key:=Range("C8", "C" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With WS.Sort .SetRange Range("A8", "AS" & LR) .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Arr = WS.Range("A8", "AS" & LR).Value Application.DisplayAlerts = False WS.Delete Application.DisplayAlerts = True i = 1: j = 1 For x = 1 To UBound(Arr) If Arr(x, 16) = "الاول" Then SS(i, 1) = i: SS(i, 2) = "'" & Arr(x, 2): SS(i, 3) = Arr(x, 3): SS(i, 4) = Arr(x, 4): SS(i, 5) = Arr(x, 5) SS(i, 6) = Arr(x, 7): SS(i, 7) = Arr(x, 23): SS(i, 8) = Arr(x, 18): SS(i, 9) = Arr(x, 45) z = z + 1 If z = 25 Then z = 0: i = i + 5 Else i = i + 1 End If End If If Arr(x, 17) = "الثانى" Then SS2(j, 1) = j: SS2(j, 2) = "'" & Arr(x, 2): SS2(j, 3) = Arr(x, 3): SS2(j, 4) = Arr(x, 4): SS2(j, 5) = Arr(x, 5) SS2(j, 6) = Arr(x, 18) zz = zz + 1 If zz = 30 Then zz = 0: j = j + 5 Else j = j + 1 End If End If Next With Sheets("شرط اول") LR = .Range("A" & Rows.Count).End(xlUp).Row If LR > 6 Then .Range("A8", "I" & LR).ClearContents .Range("A8").Resize(UBound(Arr), 9) = SS For i = 1 To Application.RoundUp((Application.Match(9 ^ 9, .Range("A:A"), 1) - 7) / 29, 0) .HPageBreaks.Add Before:=Cells(29 * i + 8, 1) .Cells(29 * i + 4, 1) = "مراجع أول" & String(25, " ") & "مراجع ثاني" & String(25, " ") & "مراجع ثالث" & String(25, " ") & "مراجع رابع" & String(25, " ") & "مراجع خامس" .Range("A" & 29 * i + 4, "I" & 29 * i + 4).HorizontalAlignment = xlCenterAcrossSelection .PageSetup.PrintArea = [Criteria1].Address .PageSetup.PrintTitleRows = "$1:$7" Next End With With Sheets("شرط ثانى") LR = .Range("A" & Rows.Count).End(xlUp).Row If LR > 6 Then .Range("A8", "I" & LR).ClearContents .Range("A8").Resize(UBound(Arr), 9) = SS2 For i = 1 To Application.RoundUp((Application.Match(9 ^ 9, .Range("A:A"), 1) - 7) / 34, 0) .HPageBreaks.Add Before:=Cells(34 * i + 8, 1) .Cells(34 * i + 4, 1) = "مراجع أول" & String(15, " ") & "مراجع ثاني" & String(15, " ") & "مراجع ثالث" & String(15, " ") & "مراجع رابع" & String(15, " ") & "مراجع خامس" .Range("A" & 34 * i + 4, "F" & 34 * i + 4).HorizontalAlignment = xlCenterAcrossSelection .PageSetup.PrintArea = [Criteria2].Address .PageSetup.PrintTitleRows = "$1:$7" Next End With End With End Sub

استخدم هذا الكود بعد تحديث الفورم Private Sub Form_AfterUpdate() Me.OrderBy = "[Days]" & DESC Me.OrderByOn = True End Sub

السلام عليكم اخى العزيز حتى لا نظل ندور فى حلول متعددة ونفقد مميزات الكود الاصلى يمكنك التنازل عن ترحيل المسلسل كما هو فى الجدول الرئيسي بحيث يبدا كل جدول فرعي (شرط اول و شرط ثانى ) بمسلسل جديد من 1 وحتى عدد الصفوف المطابقة وبهذا يعمل الكود الاصلى بدون اي مشاكل كما بالكود التالى Option Explicit Sub TransferdataByTwoConditions() Dim LR As Long, x As Long, i As Long, j As Long, z As Long, zz As Long Application.ScreenUpdating = 0 With Sheets("الرئيسية") LR = .Range("A" & Rows.Count).End(xlUp).Row ReDim Arr(1 To LR, 1 To 45) ReDim SS(1 To LR, 1 To 9) ReDim SS2(1 To LR, 1 To 9) Arr = .Range("A8", "AS" & LR).Value Dim WS As Worksheet Set WS = Sheets.Add(After:=Sheets(Worksheets.Count)) WS.Range("A8", "AS" & LR) = Arr WS.Sort.SortFields.Clear WS.Sort.SortFields.Add Key:=Range("D8", "D" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal WS.Sort.SortFields.Add Key:=Range("C8", "C" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With WS.Sort .SetRange Range("A8", "AS" & LR) .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Arr = WS.Range("A8", "AS" & LR).Value Application.DisplayAlerts = False WS.Delete Application.DisplayAlerts = True i = 1: j = 1 For x = 1 To UBound(Arr) If Arr(x, 16) = "الاول" Then SS(i, 1) = i: SS(i, 2) = "'" & Arr(x, 2): SS(i, 3) = Arr(x, 3): SS(i, 4) = Arr(x, 4): SS(i, 5) = Arr(x, 5) SS(i, 6) = Arr(x, 7): SS(i, 7) = Arr(x, 23): SS(i, 8) = Arr(x, 18): SS(i, 9) = Arr(x, 45) z = z + 1 If z = 25 Then z = 0: i = i + 5 Else i = i + 1 End If End If If Arr(x, 17) = "الثانى" Then SS2(j, 1) = j: SS2(j, 2) = "'" & Arr(x, 2): SS2(j, 3) = Arr(x, 3): SS2(j, 4) = Arr(x, 4): SS2(j, 5) = Arr(x, 5) SS2(j, 6) = Arr(x, 18) zz = zz + 1 If zz = 30 Then zz = 0: j = j + 5 Else j = j + 1 End If End If Next With Sheets("شرط اول") LR = .Range("A" & Rows.Count).End(xlUp).Row If LR > 6 Then .Range("A8", "I" & LR).ClearContents .Range("A8").Resize(UBound(Arr), 9) = SS For i = 1 To Application.RoundUp((Application.Match(9 ^ 9, .Range("A:A"), 1) - 7) / 29, 0) .HPageBreaks.Add Before:=Cells(29 * i + 8, 1) .Cells(29 * i + 4, 2) = "مراجع أول": .Cells(29 * i + 4, 3) = "مراجع ثاني" .Cells(29 * i + 4, 5) = "مراجع ثالث": .Cells(29 * i + 4, 7) = "مراجع رابع" .Cells(29 * i + 4, 9) = "مراجع خامس" .PageSetup.PrintArea = [Criteria1].Address .PageSetup.PrintTitleRows = "$1:$7" Next End With With Sheets("شرط ثانى") LR = .Range("A" & Rows.Count).End(xlUp).Row If LR > 6 Then .Range("A8", "I" & LR).ClearContents .Range("A8").Resize(UBound(Arr), 9) = SS2 For i = 1 To Application.RoundUp((Application.Match(9 ^ 9, .Range("A:A"), 1) - 7) / 34, 0) .HPageBreaks.Add Before:=Cells(34 * i + 8, 1) .Cells(34 * i + 4, 2) = "مراجع أول": .Cells(34 * i + 4, 3) = "مراجع ثاني" .Cells(34 * i + 4, 4) = "مراجع ثالث": .Cells(34 * i + 4, 6) = "مراجع رابع" .PageSetup.PrintArea = [Criteria2].Address .PageSetup.PrintTitleRows = "$1:$7" Next End With End With End Sub

جرب هذا الملف مثال Salim.rar

السلام عليكم لا اخفى عليك انى رايت تلك المشكله لكن ظننت انها فى جهازى فقط لذلك ارسلت لك الكود لتجربته لانى لم يتسع لى الوقت للبحث حينها .. لكنك اشرت الى الحل اعلاه وهو الخاصية Creterial 1 و Creterial 2 100 والسر هو ان الخواص السابقة تعتمد بشكل اساسى على مكان اكبر رقم فى خانة المسلسل وهى العمود الاول وللصدفة فان اكبر مسلسل فى ورقة العمل"شرط اول" هو وبسب الترتيب ظهرت فى الصفحة الاولى من الطباعه وبالتالى قامت الخاصية بتحديد مجال الطباعة على الصفحة الاولى فقط اما فى ورقة العمل الاخرى فقد كان مكان اقصى مسلسل وهو 95 في الصفحة الثانية وبالتالى لم تتكرر المشكلة والحل بسيط وهو تجاهل تلك الخواص واستبدال الاسطر التالية .PageSetup.PrintArea = [Criteria1].Address بالسطر .PageSetup.PrintArea = Range("A1", "I" & 29 * i + 7).Address .PageSetup.PrintArea = [Criteria2].Address بالسطر .PageSetup.PrintArea = Range("A1", "F" & 34 * i + 7).Address

ارسل تقرير عن المشاركه قام بنشر October 22 السلام عليكم ورحمة الله وبركاته أخي زياد شكرا على الملاحظات و التنبيهات انشاء الله سأفي بوعدي ومازلت على وعدي أما بي النسبة للاعلنات التي أقوم بها هي من باب التحفيز الأعضاء وتنشيطهم أما بي النسبة لي عدم ارفاق الملفات و تأخيرها فقط لم يتسع لي الوقت لأن شرحها يستغرق الكثير من الوقت و مشكل ضيق الوقت أدرس رغم اني ادرس 24 ساعة اي اني أدرس أكثر من 22 ساعة وهذا ماأرهقني كثيرا اما بي النسبة البرامج فهي جاهزة شكرا على ملاحظاتك لأن ملاحظاتكم تهمنا وهذا شيئ جميل و انشاء الله سترى الجميل في اكسل كن صبورا فقط.تحياتي الخالصة لك اخي زياد.

وعليكم السلام أخي الكريم في المرفق الذي أرسلته أنت وفي صفحة العميل "" محمد عوض على على "" ستجد أنك أدخلت بالخلية A10 ,A12 توارخ خاطئة 30/02/2018 و 30/02/2019 فمن المعروف أن شهر فبراير ليس به اليوم 30 عدلها إلي 28/02/2018 و 28/02/2019 ستجد المعادلة مضبوطة مرفق الملف بعد التعديل حسابات العملاء2.rar

السلام عليكم ورحمة الله وبركاته قم ياضافة السطر التالى للكود لاضافة الترتيب بعمود اخر WS.Sort.SortFields.Add Key:=Range("D8", "D" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal Dim WS As Worksheet Set WS = Sheets.Add(After:=Sheets(Worksheets.Count)) WS.Range("A8", "AS" & LR) = ARR WS.Sort.SortFields.Clear WS.Sort.SortFields.Add Key:=Range("D8", "D" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal WS.Sort.SortFields.Add Key:=Range("c8", "c" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With WS.Sort .SetRange Range("A8", "AS" & LR) .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With

السلام عليكم تفضل المعادلة بعد التعديل =CONCATENATE(MID(E$34,1,4)+INT((MID(E$34,6,2)+D$26-2)/12),"/",TEXT(IF(MOD(MID(E$34,6,2)+D26,12)>1,MOD(MID(E$34,6,2)+D$26-1,12),MOD(MID(E$34,6,2)+D$26,12)+11),"00"),"/",RIGHT(E34,2))

السلام عليكم الاخ الفاضل ابو عبد الرحمن وسلمى اظن ان طلبك هو ترتيب الناتج ابجديا ولذلك قمت بعمل الحل التالى لترتيب الشيت الرئيسي فى شيت مؤقت ثم اعادة اخذ البيانات منه وبالتالى قد تم ترتيب المخرجات بترتيب ابجدى بالكامل وليس داخل كل صفحة كما المرفق . واتمنى ان يكون ذلك الحل يفى بالغرض نقل البيانات من الرئيسية الى ورقتين بشرطين مختلفين مع ادراج فواصل الصفحات وترك 4 صفوف فارغة للتذييل- والترتيب.rar

شوف انا فاعم نظريا معنى () وهى اختصار لــ keep performance indicator examples أى مؤشر قياس الأداء دلالة للقياس الذى يشير إلى الأداء الفعلي لمقارنته بالأهداف المطلوب على سبيل المثال: - الهدف المطلوب تحقيقه للمؤسسة فى الإستجابة لطلابات العملاء هو 90 % فى الساعة الواحده . تم استقبال عدد 1000 طلب من العملاء خلال ساعة . تم استجابة 850 طلب في خلال ساعة . المطلوب تحديد نسبة الأداء الفعلى وتحديد الإنحراف عن الهدف المخطط. الأداء الفعلى= عدد العملاء الذين تم الإستجابة لهم خلال الساعة ÷ إجمالي طلبات العملاء 850 ÷ 1000 X 100 = 85% الإنحراف = الأداء الفعلى – الهدف المطلوب اذن الإنحراف= 85 % - 90% = – 5% تم الإنحراف عن الهدف المطلوب بنسبة سالب 5% بناء على ما سبق ان مؤشر قياس الاداء هو عباره عن معادلة رياضيه معطيات ، معلوم ، مجهول لو حضرتك انتهيت من وضع المعادلات الرياضيه وحلها والوصول للنتائج تقدر تعمل الـ Graph Chart بكل سهوله

السلام عليكم أخي مراد تفضل المرفق إن شاء الله أكون تفاديت هذا الخطـأ فاتورة جديدة7.rar