توزيع على اللجان

[عبدالله باقشير]

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

نموذج توزيع على ثلاث لجان في ورقة واحدة للطباعة

ورقة طباعة بالعرض

بادخال عدد صفوف اللجان

طلب للاخ / أيسم إبراهيم

جعلته هنا لتعم الفائدة

كود التوزيع:

Sub KH_START()
    On Error Resume Next
    Dim MyRang_1 As Range, MyRang_2 As Range, MyRang_Formats As Range
    Dim S As Integer, E As Integer, W As Integer, V As Integer, T As Integer, TT As Integer _
    , H As Integer, M As Integer, Y As Integer, Z As Integer, N As Integer, U As Integer _
    , R As Integer, C As Integer, CC As Integer, O As Integer, EE As Integer, SS As Integer
    '=======================================
    If [B2] = False Then MsgBox "تاكد من الشرط في الخلية B2", vbMsgBoxRtlReading, "تنبيه": GoTo 1
    '=======================================
    S = Application.CountA(ورقة1.Range("B6:B1005"))  ' عددالطلبة
    E = [E2]    ' عدد طلاب اللجنة
    T = Application.RoundUp(S / (E * 3), 0)  ' عدد الكشوفات
    TT = Application.RoundUp(S / E, 0)
    W = 7     ' عدد الصفوف الخارجة عن التوزيع في ورقة الكشوفات
    V = 5     ' عدد الصفوف الخارجة عن التوزيع في ورقة البيانات
    H = E + 4 + 3  ' عدد طلاب اللجان زايدا رؤؤس الاعمدة والتذييل
    Set MyRang_1 = Range("راس_اللجان")
    Set MyRang_2 = Range("تذييل_اللجان")
    Set MyRang_Formats = Range("فورمات")
    KH_Clear
    '================================
    Application.ScreenUpdating = False
    ActiveWindow.View = xlPageBreakPreview
    '================================
    For M = 1 To T
        If M <> 1 Then
            MyRang_1.Copy Range("B" & W - 3)
            Set ActiveSheet.HPageBreaks(M - 1).Location = Range("B" & W - 3)
        End If
        Y = 2
        For Z = 1 To 3
            EE = Application.RoundUp((S - (V - 5)) / (TT - SS), 0)
            SS = SS + 1
            MyRang_Formats.Copy
            Cells(W + 1, Y).Resize(E, 5).PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
            MyRang_2.Copy Cells(W + E + 1, Y)
            For N = 1 To EE
                U = N + W: R = N + V
                For C = 1 To 4
                    CC = Choose(C, 11, 2, 8, 10)
                    Cells(U, Y + C) = ورقة1.Cells(R, CC)
                Next C
                If Cells(U, Y + 1) <> "" Then Cells(U, Y) = N
            Next N
            V = V + EE: Y = Y + 6
        Next Z
        W = W + H
    Next M
    '================================
    ActiveWindow.View = xlNormalView
    With ActiveSheet
        O = .UsedRange.Rows.Count
        .PageSetup.PrintArea = .Range("B4:R" & O).Address
    End With
    '================================
    Application.ScreenUpdating = True
    Range("A4").Activate
    معاينة
    On Error GoTo 0
1 End Sub

ودمتم في حفظ الله

______2.rar

تم تعديل يونيو 23, 2009 بواسطه خبور خير

[أيسم إبراهيم]

السلام عليكم

أستاذنا الكريم

جزاك الله كل الخير وجعله في ميزان حسناتك مثاقيل كثيرة

أدامكم الله عونا في الخير

تقبل تحياتي و احترامي

أيسم إبراهيم

[أيسم إبراهيم]

السلام عليكم

أستاذنا الكريم

أنا آسف جدااااااااااااااااااااااااااااا. نتثاقل عليك بطلباتنا.

أليس من الممكن تحقيق هذا المطلب الهام؟؟؟؟؟؟؟؟؟؟؟؟

عمل إحصاء بعدد المسلمين والمسيحيين في كل لجنة. ( مهم جدا جدا جدا )

سواء في أعلى الصفحة أو في أسفلها.

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

تم تعديل يونيو 23, 2009 بواسطه aysam

[محمدي عبد السميع]

يارب يامن رفعت السماء بدون عمد

ارفع قدر العالم العلامة

في الدنيا والآحرة

عمل ولاأروع

[Ahmed Emannan]

مشكور اخي خبور وبارك الله فيك

[علي المصري]

شكرا جزيل

استفدت من اعمالك كتييييييييييييييييييييييير

[قصي]

الف مليون شكر

روعه روعه

جزيت الجنه

[عبدالله باقشير]

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

الاخ الحبيب/ محمدي-----------حفظه الله

الاخ الفاضل/ صفوت-----------حفظه الله

الاخ الفاضل/ math-----------حفظه الله

الاخ الفاضل/ قصي-----------حفظه الله

مشكورين على المرور وحسن التشجيع

الاخ الفاضل/ أيسم إبراهيم -----------حفظه الله

عمل إحصاء بعدد المسلمين والمسيحيين في كل لجنة. ( مهم جدا جدا جدا )

سواء في أعلى الصفحة أو في أسفلها.

عملناها في اعلى الصفحة

=COUNTIF(OFFSET(E7;1;;$E$2;1);"مسلم*")

وفي التذييل

=COUNTIF(OFFSET(W4;$E$2*-1;;$E$2;1);"مسلم*")

اختار ما تشاء

______2.rar

[قصي]

ايه الروعه دي يا عمنا

شوف لنا فكرة تطلع للصف التاني او التالت

تم تعديل يونيو 24, 2009 بواسطه قصي

[سالم شباني]

السلام عليكم أستاذنا الفاضل خبور

أعمالك مميزة وفي كل مرة يأتي منك الإبداع

الله يقدرنا على فهمها واستعمالها في حياتنا

سأضع طلبا في هذا الموضوع أتمنى أن تساعدني فيه

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

[هشام شلبى]

بسم الله تبارك الله

كود يدر س بارك الله لك وفيك

[أيسم إبراهيم]

السلام عليكم

أستاذنا الجليل

بسم الله تبارك الله

كود يدر س بارك الله لك وفيك

أعمالك مميزة وفي كل مرة يأتي منك الإبداع

الله يقدرنا على فهمها واستعمالها في حياتنا

ايه الروعه دي يا عمنا

روعه روعه

جزيت الجنه

جزاك الله كل الخير وجعله في ميزان حسناتك مثاقيل كثيرة

أدامكم الله عونا في الخير

خلصت فيك حلو الكلام......

[يوسف عطا]

ممكن سؤال عن الأكواد

كيف اصنع كود معين يحقق طلب معين

والأهم كيف أضع الكود فى ملف الإيكسيل

مشكوووووووووووووووووووووورين