ناصر سعيد

====================================================== Sub معاينة_ترم_ثانى() Dim LatR As Long LatR = Range("b:b").Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row With ActiveSheet .PageSetup.PrintArea = "b2:ab" & LatR ActiveWorkbook.Application.DisplayFullScreen = False ActiveWorkbook.Application.DisplayFormulaBar = True ActiveWindow.SelectedSheets.PrintPreview End With End Sub Sub طباعة_ترم_اول() Dim LatR As Long LatR = Range("b:b").Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row With ActiveSheet .PageSetup.PrintArea = "b2:ab" & LatR .PrintOut End With End Sub Sub طباعة_ترم_ثانى() Dim LatR As Long LatR = Range("b:b").Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row With ActiveSheet .PageSetup.PrintArea = "b2:ab" & LatR .PrintOut End With End Sub للمحترم الاستاذ عبد الباري البنا

Sub ماكرو1() For Q = 2 To ActiveSheet.UsedRange.Rows.Count If Cells(Q, 1) = "" And Cells(Q, 2) = "" Then Rows(Q).Hidden = True End If Next Q End Sub المطلوب .. كود لعمل معاينة لصفحة بيانات. المفروض ان الكود بيعمل معاينة للجزء الذي به بيانات من الصفحة ويتجاهل الجزء الخالي من البيانات . الاجابه للمحترم القدير احمد زمان السلام عليكــم ورحمـة الله وبركاتــه ،، اخي الفاضل بحيث يعمل على العامودين A-B فأي عمود منهما به بيانات يبقى موجود تم الحل بـ 3 طرق اختار منها ماتريد 1 - اخفاء الفارغ 2 - حذف الفارغ 3 - في الورقة 2 باستخدام التصفية التلقائية (اخفاء و اظهار) يمكنك تعديل اي كود منهما كما تريد مع التحية RESULT.rar هل يمكن من المحترمين اضافه سطر لتظهر المعاينه ؟

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

حفظك الله ورعاك .. ولكن هذا السطر اريد مزيد من التوضيح بمعنى اخر لو ازلنا هذا السطر مثلا ماذا يحدث ؟

الاصدار الجديد الثامن الصف الاول الابتدائي http://up.top4top.net/downloadf-355u43cq1-rar.html ============================ الصف الثاني الابتدائي http://up.top4top.net/downloadf-3551s9322-rar.html ============================ الصف الثالث http://up.top4top.net/downloadf-355c6hdr3-rar.html ============================ الصف الرابع http://up.top4top.net/downloadf-362xnb4c1-rar.html ============================ الصف الخامس http://up.top4top.net/downloadf-3622lexk1-rar.html ============================ رابط كلمه السر http://up.top4top.net/downloadf-top4top_223f4fe93b4-rar.html =============================================== رابط اخر هديه للاستاذ عبد الباري خاص ببرنامج الابتدائي http://up.top4top.net/downloadf-340rzdbp1-rar.html ======================================= وهذا رابط لبرنامج الاعدادي http://up.top4top.net/downloadf-340bahmr1-rar.html كنترول المحترم ربنا يبارك له الاستاذ عبد الباري البنا ================================================================= روابط اخرى لما سبق من برنامجين للاستاذ المحترم عبد الباري البنا كنترول شيت إعدادي ..الدورين معا ..اصدار4 كلمة سر الدخول : 1111 كلمة سر محرر الاكواد : 11223344 كلمة سر صفحة الصلاحيات :6666 كلمة سر تصفير الشيت: 6666 رابط التحميل كنترول شيت اعدادى 2017 و كنترول شيت ابتدائى..الدورين معا ..اصدار4 كلمة سر الدخول : 1111 كنترول شيت ابتدائى 2017

رابط اخر هديه للاستاذ عبد الباري خاص ببرنامج الابتدائي http://up.top4top.net/downloadf-340rzdbp1-rar.html ======================================= وهذا رابط لبرنامج الاعدادي http://up.top4top.net/downloadf-340bahmr1-rar.html كنترول المحترم ربنا يبارك له الاستاذ عبد الباري البنا ================================================================= روابط اخرى لما سبق من برنامجين للاستاذ المحترم عبد الباري البنا كنترول شيت إعدادي ..الدورين معا ..اصدار4 كلمة سر الدخول : 1111 كلمة سر محرر الاكواد : 11223344 كلمة سر صفحة الصلاحيات :6666 كلمة سر تصفير الشيت: 6666 رابط التحميل كنترول شيت اعدادى 2017 و كنترول شيت ابتدائى..الدورين معا ..اصدار4 كلمة سر الدخول : 1111 كنترول شيت ابتدائى 2017

جزاكم الله خيرا

Sub abo_abary() [g2] = [e3] For i = [e3] To [f3] Step 2 [g2] = i ActiveWindow.SelectedSheets.PrintOut Copies:=1 Next End Sub جزاكم الله كل خير ارجوكم اشرحو الكود عشان افهمه وما فائده ال g2

Sub Printing() For J = 1 To [I2] Step 2 If J <= [I2] Then [I4] = J ActiveWindow.SelectedSheets.PrintOut Copies:=1 End If Next [I4] = 1 End Sub كود متميز ..جزاك الله الف خير يا اخي الكريم بن عليه ========================================= قد يكون العدد الاجمالي كبير ولذلك كرما منك نريد ان يكون فيه جدول به من 1 الى ... العدد الذي نبغاه

دعوه خالصة لوجه الله ان يعطيك ما تتمناه

الاصدار الجديد الثامن الصف الاول الابتدائي http://up.top4top.net/downloadf-355u43cq1-rar.html ============================ الصف الثاني الابتدائي http://up.top4top.net/downloadf-3551s9322-rar.html ============================ الصف الثالث http://up.top4top.net/downloadf-355c6hdr3-rar.html ============================ الصف الرابع http://up.top4top.net/downloadf-362xnb4c1-rar.html ============================ الصف الخامس http://up.top4top.net/downloadf-3622lexk1-rar.html ============================ رابط كلمه السر http://up.top4top.net/downloadf-top4top_223f4fe93b4-rar.html

ملك المعادلات بن عليه حاجي ربنا يبارك لك

Sub معاينة_ترم_اول() Dim LatR As Long LatR = Range("b:b").Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row With ActiveSheet .PageSetup.PrintArea = "b2:ab" & LatR ActiveWorkbook.Application.DisplayFullScreen = False ActiveWorkbook.Application.DisplayFormulaBar = True ActiveWindow.SelectedSheets.PrintPreview End With End Sub نريد من فضلكم شرح لهذا الكود

================================================ عفوا .. عندما تقرأ الموضوع وتريد ان تشارك بمشاركه اجعل مقاس الخط 26 لون الخط بلون غامق اجعل كتاباتك في وسط الصفحة وشكرا لتفاعلكم

ولااروع .. سهولة في التطبيق .. سرعه في التنفيذ كود استدعاء للمبدع ياسر العربي Sub ALL() ''هذا الكود للعبقري ياسر العربي حفظه الله '' تم هذا الكود بتاريخ 8 / 10/ 2016 ''الهدف من الكود هو استدعاء البيانات ''شرح الكود ''متغيرات Dim myArray, lr, X, targt, targt1, targt2, targtN Dim SERCH As Worksheet, _ DATA As Worksheet '____________________________________________ 'اسم شيت قاعدة البيانات Set DATA = Worksheets("رصد الترم الثانى") 'اسم الشيت الخاص بالبحث Set SERCH = Worksheets("كشوف الطلبه") '____________________________________________ 'المدى الذي سيتم مسحه في صفحه الهدف Range("D10:AB1000").Clear 'المدى الذي سيتم نسخه لعدد محدد بخليه محدده Range("C9:AB9").AutoFill _ Destination:=Range("C9:AB" & _ Range("B4").Value + 8), Type:=xlFillDefault 'اخر صف به بيانات lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row + 2 'مدى صفحة الهدف وهو يبدأ بعد عمود المسلسل 'والرقم الموجود هو رقم عمود البدايه ' 'مسح نطاق البحث القديم SERCH.Range("D9:AB" & SERCH.Cells(Rows.Count, 4) _ .End(xlUp).Row + 1).ClearContents 'معيارين البحث ' targt2 = targt targt = "له* دور ثان في" targt2 = "ناجح" 'نطاق قاعدةالبيانات ' صفحة المصدرالذي سيتم البحث فيه myArray = DATA.Range("A7:FF" & lr) '____________________________________________ ReDim Y(1 To UBound(myArray, 1), 1 To _ UBound(myArray, 2)) For X = LBound(myArray) To _ UBound(myArray) If targt = "" Then Exit Sub 'هنا التعديل للمعيارين If myArray(X, 101) Like targt & "*" _ Or myArray(X, 101) Like targt2 & _ "*" Then rw = rw + 1 'متغير ارقام 'الاعمده المطلوب الاستدعاء منها 'العمود التاني بعد المسلسل Y(rw, 1) = myArray(X, 2) 'العمود الثالث بعد المسلسل Y(rw, 2) = myArray(X, 3) 'العمود الرابع بعد المسلسل Y(rw, 3) = myArray(X, 13) 'العمود الخامس بعد المسلسل Y(rw, 4) = myArray(X, 22) 'العمود السادس بعد المسلسل وهكذا Y(rw, 5) = myArray(X, 31) Y(rw, 6) = myArray(X, 40) Y(rw, 7) = myArray(X, 51) Y(rw, 8) = myArray(X, 52) Y(rw, 9) = myArray(X, 82) Y(rw, 10) = myArray(X, 101) Y(rw, 11) = myArray(X, 102) ' Y(rw, 12) = myArray(X, 110) ' Y(rw, 13) = myArray(X, 111) End If Next X If rw > 0 Then SERCH.Cells(Rows.Count, 4).End(xlUp)(2, 1).Resize(rw, 13).Value = Y() End Sub الاستدعاء بطريقه ( خليفه عبد الله باقشير ) الاستاذ ياسر.rar

ولااروع سهولة في التطبيق .. سرعه في التنفيذ كود استدعاء للمبدع ياسر العربي Sub ALL() ''هذا الكود للعبقري ياسر العربي حفظه الله '' تم هذا الكود بتاريخ 8 / 10/ 2016 ''الهدف من الكود هو استدعاء البيانات ''شرح الكود ''متغيرات Dim myArray, lr, X, targt, targt1, targt2, targtN Dim SERCH As Worksheet, _ DATA As Worksheet '____________________________________________ 'اسم شيت قاعدة البيانات Set DATA = Worksheets("رصد الترم الثانى") 'اسم الشيت الخاص بالبحث Set SERCH = Worksheets("كشوف الطلبه") '____________________________________________ 'المدى الذي سيتم مسحه في صفحه الهدف Range("D10:AB1000").Clear 'المدى الذي سيتم نسخه لعدد محدد بخليه محدده Range("C9:AB9").AutoFill _ Destination:=Range("C9:AB" & _ Range("B4").Value + 8), Type:=xlFillDefault 'اخر صف به بيانات lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row + 2 'مدى صفحة الهدف وهو يبدأ بعد عمود المسلسل 'والرقم الموجود هو رقم عمود البدايه ' 'مسح نطاق البحث القديم SERCH.Range("D9:AB" & SERCH.Cells(Rows.Count, 4) _ .End(xlUp).Row + 1).ClearContents 'معيارين البحث ' targt2 = targt targt = "له* دور ثان في" targt2 = "ناجح" 'نطاق قاعدةالبيانات ' صفحة المصدرالذي سيتم البحث فيه myArray = DATA.Range("A7:FF" & lr) '____________________________________________ ReDim Y(1 To UBound(myArray, 1), 1 To _ UBound(myArray, 2)) For X = LBound(myArray) To _ UBound(myArray) If targt = "" Then Exit Sub 'هنا التعديل للمعيارين If myArray(X, 101) Like targt & "*" _ Or myArray(X, 101) Like targt2 & _ "*" Then rw = rw + 1 'متغير ارقام 'الاعمده المطلوب الاستدعاء منها 'العمود التاني بعد المسلسل Y(rw, 1) = myArray(X, 2) 'العمود الثالث بعد المسلسل Y(rw, 2) = myArray(X, 3) 'العمود الرابع بعد المسلسل Y(rw, 3) = myArray(X, 13) 'العمود الخامس بعد المسلسل Y(rw, 4) = myArray(X, 22) 'العمود السادس بعد المسلسل وهكذا Y(rw, 5) = myArray(X, 31) Y(rw, 6) = myArray(X, 40) Y(rw, 7) = myArray(X, 51) Y(rw, 8) = myArray(X, 52) Y(rw, 9) = myArray(X, 82) Y(rw, 10) = myArray(X, 101) Y(rw, 11) = myArray(X, 102) ' Y(rw, 12) = myArray(X, 110) ' Y(rw, 13) = myArray(X, 111) End If Next X If rw > 0 Then SERCH.Cells(Rows.Count, 4).End(xlUp)(2, 1).Resize(rw, 13).Value = Y() End Sub الاستدعاء بطريقه ( خليفه عبد الله باقشير ) الاستاذ ياسر.rar

رابط مفيد لنسخ صف لعدة صفوف شكرا لكم

ربنا يبارك في النافع

كشوف لجان متميزه Sub PrintFrom8_To_() MsgBox "للحصول على طباعة كاملة يجب عدم ملامسة الماوس أو لوحة المفاتيح أثناء الطباعة" Dim I As Integer For I = Range("t7") To Range("u7") Step 2 If I <= Range("u7") Then Range("e5") = I ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True End If Next I Range("e5").Select End Sub كشوف لجان متميزه.rar

ملف لتوزيع اللجان طباعـــــــــــــه صفحات.rar استدعاء بيانات بطريقه سريعه جدا ''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''' Sub DOR_tan() ''هذا الكود للعبقري ياسر العربي حفظه الله '' تم هذا الكود بتاريخ 8 / 10/ 2016 ''الهدف من الكود هو فلترة البيانات ''شرح الكود '' Dim myArray, lr, X, targt, targt1, targt2, targtN Dim SERCH As Worksheet, DATA As Worksheet '____________________________________________ Set DATA = Worksheets("رصد الترم الثانى") 'اسم شيت المصدر Set SERCH = Worksheets("كشف الدور الثاني") 'اسم الشيت الهدف '____________________________________________ Range("A8:R1000").Clear 'النطاقات متغيره Range("B7:R7").AutoFill Destination:=Range("B7:R" & Range("A4").Value + 6), Type:=xlFillDefault lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row + 2 'اخر صف به بيانات 'رقم عمود البدايه اللي بعد المسلسل ' متغير SERCH.Range("C7:N" & SERCH.Cells(Rows.Count, 3).End(xlUp).Row + 1).ClearContents 'مسح نطاق البحث القديم targt = "له* دور ثان في" 'معيار البحث 'نطاق قاعدةالبيانات المصدر الذي سيتم البحث فيه myArray = DATA.Range("A7:EF" & lr) '____________________________________________ 'عدد الاعمده في الجدول في صفحه الهدف ReDim y(1 To lr, 1 To 13) For X = 1 To lr - 6 If targt = "" Then Exit Sub 'رقم عمود معيار البحث If myArray(X, 101) Like targt & "*" Then rw = rw + 1 'For ww = 1 To 102 ' Y(rw, ww) = myArray(X, ww) ' Next ww 'العمود التاني بعد المسلسل y(rw, 1) = myArray(X, 2) 'العمود الثالث بعد المسلسل y(rw, 2) = myArray(X, 3) 'العمود الرابع بعد المسلسل y(rw, 3) = myArray(X, 13) 'العمود الخامس بعد المسلسل y(rw, 4) = myArray(X, 22) 'العمود السادس بعد المسلسل وهكذا y(rw, 5) = myArray(X, 31) y(rw, 6) = myArray(X, 40) y(rw, 7) = myArray(X, 51) y(rw, 8) = myArray(X, 52) y(rw, 9) = myArray(X, 82) y(rw, 10) = myArray(X, 101) y(rw, 11) = myArray(X, 102) ' Y(rw, 12) = myArray(X, 110) ' Y(rw, 13) = myArray(X, 111) End If Next X If rw > 0 Then SERCH.Cells(Rows.Count, 3).End(xlUp)(2, 1).Resize(rw, 13).Value = y() End Sub استدعاء بيانات بطريقه سريعه.rar

اين المشرفين وادارة المنتدى العظيم ؟

إن شاء الله موضوع مفيد جزاكم الله خيرا

للرفع

ربنا يبارك في النافع

الملف طباعـــــــــــــه صفحات.rar