ناصر سعيد

اخي المحترم بن عليه يحفظك الله ويرعاك هل يمكن ان تقف عمليه الطبع الى الرقم الاخير والشهادات الباقيه في الصفحه تظهر فارغه === بمعنى لو اعطينا ارقام الجلوس من 5 الى 8 في هذه الحاله ستظهر 4 شهادات والصفحه بها 3 شهادات اذن : المطلوب في الصفحه التانيه تظهر شهاده واحده مملوءه ( تكمله امر الطبع ) والشهادتين الاخيرتين يظهرا فارغتان

مامعنى هذه الجمله من فضلك ؟

ربنا يحفظكما ويرعاكما يارب استاذ زيزو والاستاذ بن عليه حلول ولا اروع Sub PRINT_FromTo() For I = Cells(3, "U") To Cells(3, "V") Step 3 Cells(4, "Q") = I ActiveWindow.SelectedSheets.PrintOut Copies:=1 Next End Sub ========== Sub PRINT_ALL() For I = [MinV] To [MaxV] Step 3 Cells(4, "Q") = I ActiveWindow.SelectedSheets.PrintOut Copies:=1 Next End Sub ========= =SMALL(شيت!$A:$A;1+COUNTIF(شيت!$A:$A;0)) كرما منك شرح هذا السطر

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

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

هذا الموضوع من اهم المواضيع لرجالات الكنترول ففيه اكواد غايه في الدقه والروعه نرجوا ان نضع الاضواء عليه

Option Explicit Sub ExportCertificatesToPDF() Dim lr As Long Dim grade As String Dim wb As Workbook Dim i As Long Application.ScreenUpdating = False lr = Sheets("Data").Cells(Rows.Count, 3).End(xlUp).Row - 4 grade = Sheets("Data").Range("C1").Value 'Grade Title Set wb = Workbooks.Add(xlWBATWorksheet) i = 1 With ThisWorkbook.Sheets("Certificates") Do Until i > lr .Range("O1").Value = i .Copy After:=wb.Worksheets(wb.Worksheets.Count) i = i + 3 '3 Number Of Certificates Loop .Range("O1").Value = 1 End With Application.DisplayAlerts = False wb.Worksheets(1).Delete Application.DisplayAlerts = True wb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & "شهادات " & grade & ".pdf" wb.Close SaveChanges:=False Application.ScreenUpdating = True MsgBox "Done ...", 64 End Sub Export All Certificates To One PDF YasserKhalil ExcelLover.rar تحميل rar مرات التحميل :(2) الحجم :(33.253) KB

ربنا يجزيك خيرا استاذ سليم

الاستاذ وليد ملفك به جهد تشكر عليه ... ولكن كشوف المناداه يجب ان يكون لها عمود للديانه .. ليه ؟ من اجل عدد اوراق امتحان ماده التربيه الدينيه الاسلاميه والمسيحيه ودقه توزيع هذه الاوراق ثانيا : يجب ان يكون في قوائم اللجان عمود اخر يسمى الحاله ( منقول .. معيد ... دمج ) وفي هذه الحاله هاتبقى سهله جدا عمليه تلوين اسماء الطلبه ( بتوع حالات الدمج ) هانقول لو الخليه ... بها كلمه دمج لون الاسم باللون اللي انت عايزه مثلا وعلى الله قصد السبيل

للرفع رفع الله مقداركم

لرقم 12 هو اختصار للعبارة "xlCellTypeVisible" جزاك الله خيرا استاذ سليم

اسم الصفحه سيكون هو الشرط

من روائع اعمال المحترم استاذ سليم حاصبيا في فلتره البيانات الى اي عدد من الشروط (المعايير ) جزاه الله عنا كل خير وبارك فيه يارب Option Explicit Sub transfer_data() 'هذا الكود للمحترم سليم حاصبيا 'الهدف من الكود هو فلتره البيانات 'وترحيلها الى صفحات 'تم هذا الكود في 6/12/2007 '==================== Dim My_Rg As Range Dim S_sh As Worksheet, My_Sheet As Worksheet Dim i As Byte '====== 'عدد صفحات الملف كاملا او اكثر Dim arr(1 To 44) '====== With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With '====== 'عدد الصفحات المطلوب الترحيل اليها+ صفحة المصدر For i = 2 To 7 '====== arr(i - 1) = Sheets(i).Name Next 'اسم صفحه المصدر Set S_sh = Sheets("المصدر") 'بدايه النطاق المطلوب فلترته Set My_Rg = S_sh.Range("A14").CurrentRegion If S_sh.AutoFilterMode = False Then My_Rg.AutoFilter End If '====== 'عدد الصفحات المطلوب الترحيل اليها For i = 1 To 6 '====== Set My_Sheet = Sheets(arr(i)) 'نطاق المسح في صفحات الهدف My_Sheet.Range("B4:F500").Clear 'رقم عمود الفلتره My_Rg.AutoFilter field:=4, Criteria1:=arr(i) 'بدايه خليه النسخ في صفحات الهدف My_Rg.SpecialCells(12).Copy My_Sheet.Range("B4") My_Rg.AutoFilter Next With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With 'كي لا تبقى شيء في الذاكرة يثقلها Erase arr Set S_sh = Nothing: Set My_Sheet = Nothing: Set My_Rg = Nothing: i = 0 End Sub ====== الفكره بالرغم من بساطتها رائعه ... ترك صفين تحت الرؤوس المدمجه ... الصف الاول الذي تركناه ... يكون فاضي والصف اللي تحته يكون فيه اسماء العناوين بدون دمج حفظك الله ورعاك يا استاذ سليم ======== الفلتره للمحترم سليم حاصبيا1.rar

جزاك الله كل خير وبارك فيك استاذ / ahmedkamelelsayed0 الكود في ابهى حلته مع شرح الاسطر المطلوبه بارك الله في كل من كانت له بصمه في هذا العمل Option Explicit Sub transfer_data() 'هذا الكود للمحترم سليم حاصبيا 'الهدف من الكود هو فلتره البيانات 'وترحيلها الى صفحات 'تم هذا الكود في 6/12/2007 '==================== Dim My_Rg As Range Dim S_sh As Worksheet, My_Sheet As Worksheet Dim i As Byte '====== 'عدد صفحات الملف كاملا او اكثر Dim arr(1 To 44) '====== With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With '====== 'عدد الصفحات المطلوب الترحيل اليها+ صفحة المصدر For i = 2 To 7 '====== arr(i - 1) = Sheets(i).Name Next 'اسم صفحه المصدر Set S_sh = Sheets("المصدر") 'بدايه النطاق المطلوب فلترته Set My_Rg = S_sh.Range("A14").CurrentRegion If S_sh.AutoFilterMode = False Then My_Rg.AutoFilter End If '====== 'عدد الصفحات المطلوب الترحيل اليها For i = 1 To 6 '====== Set My_Sheet = Sheets(arr(i)) 'نطاق المسح في صفحات الهدف My_Sheet.Range("B4:F500").Clear 'رقم عمود الفلتره My_Rg.AutoFilter field:=4, Criteria1:=arr(i) 'بدايه خليه النسخ في صفحات الهدف My_Rg.SpecialCells(12).Copy My_Sheet.Range("B4") My_Rg.AutoFilter Next With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With Erase arr Set S_sh = Nothing: Set My_Sheet = Nothing: Set My_Rg = Nothing: i = 0 End Sub

Dim arr(1 To 7) For i = 2 To 7 For i = 1 To 5 هذه الجمل الثلاثه مطلوب كرما منك شرحها استاذ سليم

الصفحه الاخيره لاباتي بها اي بيانات

تم التغيير ولم تعمل معي ... ارجو تشريفنا بالرد الفلتره للمحترم سليم حاصبيا1.rar

انا كنت غيرت في اسماء الصفحات ... ولكني مستمر في اجراء التجارب وجدت عند اضافه صفحات جديده غير الموجوده لايتم الفلتره فيها ... ماهو التغيير المناسب في الكود ؟

ولماذا تختلف عن هذه الجمله For i = 1 To 4

تستحق اكثر من ذلك من الكلمات الطيبه .. جزاك الله كل خير وبارك فيك وقد تمت التجربه بعده معايير للفرز ( صفحات اكثر باسماء المعايير ) تمت بنجاح .. الخلاصه : لابد من ترك صفين تحت الرؤوس المدمجه ... الصف الاول الذي تركناه فاضي والصف اللي تحته يكون فيه اسماء العناوين بدون دمج .... أليس كذلك ؟ ============= مامهعنى هذه الجمله ولماذا هذه الارقام ؟ For i = 2 To 5 ولماذا تختلف عن هذه الجمله For i = 1 To 4

My_Rg.SpecialCells(12).Copy My_Sheet.Range("B4") مامعنى العدد 12 ... ولماذا ال 12 تم تنسيق الملف ووضع كود استاذ سليم الرائع ونتعشم في شرح الكود الفلتره للمحترم سليم حاصبيا.rar

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

يحفظك الله ويرعاك استاذ بن عليه === ويحفظك الله ويرعاك استاذ hassanask ويحفظك الله ويرعاك استاذ YasserOriba

السلام عليكم ورحمة الله وبركاته برجاء الافاده عن التخلص من هذه الرسالة Too many different cell formats

للرفع