تعديل على ملف اكسل لطباعة أكثر من صفحة

[matrix1040]

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

اعضاء المنتدى الكرام 

ارجو الافادة في التعديل على هذا الملف للشكل المرفق 

وشكرااااااااااااااااا للاعضاء الكرام 

 

بيان الحالة.xlsm

[الـعيدروس]

السلام عليكم

تفضل المرفق

بيان الحالة1.xlsm

[matrix1040]

بارك الله فيك يعجز لساني عن شكرك جعله الله في ميزان حسناتك 

 

[ناصرالمصرى]

السلام عليكم أخى وإستاذى / العيدروس

فضلا لا أمرا كيف يمكن تعديل هذا الجزء من الكود لكى تظهر الاسماء بشكل كامل وواضح

كما يقولون على سطر واحد لان الاسماء تظهر فى الــ Frame على سطرين

خاصة الاسماء الخماسية فكلما تم تكبير البنط يتم تداخل الاسماء فى بعضها 

أما إذا تم تصغير البنط الى 4 على سبيل المثال تظهر الاسماء كاملة لكنها صغيرة جدا

 

    For i = 1 To UBound(Ar)
        Set MyCBox = Frame2.Controls.Add("Forms.CheckBox.1")
        With MyCBox
            .Move 110, MyTop, 90, , True
            .Alignment = 0
            .Font.Bold = True
            .Font.Size = 6
            .Caption = Ar(i)
            .Value = False
            .Name = "A" & i
            .TextAlign = fmTextAlignRight
        End With
        MyTop = MyTop + 24
    Next
    With Me
    If MyTop > .Height Then
        .Frame2.ScrollHeight = (UBound(Ar)) * 24

فماذا يفعل أصحاب النظر الضعيف **** وما المقصود بــالرقم 24

 فهل يمكن تعديل خصائص الفوروم ليتلائم مع الجميع

شاكر فضل حضرتك وجزاكم الله خيرا

تم تعديل نوفمبر 3, 2019 بواسطه ناصرالمصرى

[الـعيدروس]

السلام عليكم

هذا Height ارتفاع الـ CheckBox * عدد الاسماء 

النتيجة نحطها ارتفاع الـ Frame2 

بيان الحالة2.xlsm

[ناصرالمصرى]

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

سؤال أخير أخى وأستاذى الفاضل 

ماذا لو أردت تشغيل هذا الفورم على أكثر من ورقه مختلفة كهدف ومصدر البيانات واحد

بمعنى فرضا لو هناك ورقة البيانات الرئيسية " المصدر " وهناك ثلاثة اوراق أخرى بإختلاف تصميمها

فهل فى هذة الحالة يتم تكرار الفورم مع تغيير أسمه ومن ثم تغيير اسم الورقه الهدف 

وهل سيكون هناك موديول لكل ورقة عمل من الاوراق الثلاثة **** أم يمكن تعديل ذلك فى الاكواد المبينه من داخل الفوروم

أرجو أن تكون الفكرة إتضحت *** شاكر فضل حضرتك وجزاكم الله خيرا

[الـعيدروس]

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

ومصدر البيانات ممكن تشير له عبر الفورم والاساس جلب البيانات

لصفحة الطباعه يحتاج تغير المصدر بكل مااردت تغير مصدر البيانات للطباعه

في الدالات الموجود بصفحة الطباعه والفورم

شاهد المرفق عدلت بحيث تحط المعطيات في بداية الكود 

 

بيان الحالة3.xlsm

[ناصرالمصرى]

كفيت ووفيت أخى وأستاذى العيدروس

بارك الله فيكم وفى أولادكم وجزاكم الله خيرا

[matrix1040]

اخي الكريم  بعد اذنك انا خبرتي قليله في الاكسيل

ماذا لو اردت نقل  ( زرار  ) الطباعة الى ملف اكسيل اخر ماهو التعديل الذي اقوم به 

 

لاني عندما اقوم بنقله يفتح ملف الاكسيل الموجود فيه بيان حالة  

[الـعيدروس]

انقل الفورم للملف الجديد 

وغير المعطيات في بداية الكود 

بإمكانك البحث بالمنتدى طريقة نقل الفورم

واستدعاء الفورم 

 

[matrix1040]

شكرا سيدي الفاضل 

توجد ملاحظه في بيان الحالة 3 

عند اضافة بيانات اخرى و اخيار الاسم لا تظهر بياناته فالخلف وعند الطباعه لا تتم طباعته

ارجو حلها

وشكراااااااااااااااا 

[الـعيدروس]

جربت اضفت بيانات جديده وطبع معي في مرفق بيان حالة 3 ؟

[matrix1040]

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

ثانيا ارجو التطبيق على هذا الملف وجعل العدد كبير 

 

2020.xlsm

[الـعيدروس]

السلام عليكم

جرب المرفق على الرابط التالي

اكيد مع حجم البيانات الكبير بيكون بطيئ

ملاحظة بسيطة على ملفك تنسيق الشيت كامل يسبب بطئ في الملف

يفضل عمل بوردر فقط لمدى البيانات وليس للشيت كامل

 

 

2020_A.xlsm

[matrix1040]

وجدت حل  بفضل اساتذتنا الكبار ولهم منا كل المحبة والإحترام وهو اني غيرت فالقائمة المنسدلة من اسم name الى عمود الاسماء 

وغيرت المعادلة امام الاسم الى

 

=VLOOKUP($O$5;'اجر وظيفي '!B:B;1;0)

الف شكر لمجهودك الرائع اخي الكريم  وبارك الله فيكم جميعا وزادكم الله من فضله ووسع الله فى ارزاقكم وفرج عنكم جميعا كربات يوم القيامة كما فرجتم كرباتى وتم حل مشكلاتى بفضل الله وبفضلكم جميعا ,جزاكم الله جميعا خير الثواب

[ناصرالمصرى]

أخى وأستاذى الفاضل / العيدروس

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

بداية جزاكم الله خيرا وبارك فيكم **** فى الحقيقة لقد أستهوانى هذا الموضوع الشيق

ولإحتياجى لهذا العمل لأكثر من ورقة عمل مختلفة من حيث التصميم كهدف ومصدر البيانات واحد

Option Base 1
Private Const Mycount As Integer = 10
Dim My_Rng As Range
Private Sub CheckBox1_Click()
With CheckBox1
    If .Value = True Then
       .Caption = "إلغاء تحديد الكل"
       PrintOut.Enabled = False
       Un_Lo True
    Else
       PrintOut.Enabled = True
       .Caption = "تحديد الكل"
       Un_Lo False
    End If
End With
End Sub
Private Function Un_Lo(Bl As Boolean, Optional Ck As Boolean)
Dim Ch_Comb As Control
For Each Ch_Comb In Me.Frame2.Controls
    If TypeOf Ch_Comb Is MSForms.CheckBox Then
       If Ck Then
          If Ch_Comb.Value = True Then
             Un_Lo = 1
          End If
       Else
       If Ch_Comb.Value <> Bl Then
        Ch_Comb.Value = Bl
       End If
       End If
    End If
Next Ch_Comb
End Function
Private Sub CommandButton4_Click()
Dim Chck As Control
Dim Sh As Worksheet
Set Sh = Sheets("ورقة2")
With Me
    If Un_Lo(True, True) = 1 Then
    For Each Chck In Me.Frame2.Controls
    If TypeOf Chck Is MSForms.CheckBox Then
        If Chck.Value = True Then
            Sh.[CA12].Value = Chck.Caption
            Sh.PageSetup.PrintArea = "$A$1:$L$50"
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
        End If
    End If
    Next Chck
    Un_Lo False, False
    Else
     Sheets("ورقة2").Select
    Sh.PageSetup.PrintArea = "$A$1:$L$50"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    End If
End With
Set Sh = Nothing
End Sub
Private Sub CommandButton6_Click()
Application.Visible = True
 Unload Me
End Sub

Private Sub Label6_Click()

End Sub

Private Sub PrintOut_Change()
Sheets("ورقة2").[CA12].Value = PrintOut.Text '''''''''''
End Sub
Private Sub UserForm_Initialize()
Dim Sh As Worksheet
Dim Ar
Set Sh = Sheets("الرئيسية")
Set My_Rng = Sh.Range("f8:f2500")
Ar = Ali_Def(My_Rng)
  Dim MyTop As Integer, i As Integer
    Dim MyCBox As Control
    Dim MyCmBox As Control
    CheckBox1.Caption = "تحديد الكل"
    MyTop = 0
    For i = 1 To UBound(Ar)
        Set MyCBox = Frame2.Controls.Add("Forms.CheckBox.1")
        With MyCBox
            .Move 200, MyTop, 200, , True
            .Alignment = 0
            .Font.Bold = True
            .Font.Size = 14
            .Caption = Ar(i)
            .Value = False
            .Name = "A" & i
            .TextAlign = fmTextAlignRight
        End With
        MyTop = MyTop + 30
    Next
    With Me
    If MyTop > .Height Then
        .Frame2.ScrollHeight = (UBound(Ar)) * 30
        .Frame2.ScrollBars = fmScrollBarsVertical
        Else
        .Frame2.ScrollBars = fmScrollBarsNone
    End If
    Me.PrintOut.List = Ali_Def(My_Rng)
    End With
End Sub
Function Ali_Def(Rng) As Variant
Dim Cell As Range
Dim Ar()
Dim Ob_A
Dim i
Dim Vr
With Sh
On Error Resume Next
End With
    Set Ob_A = CreateObject("Scripting.Dictionary")
    For Each Cell In Rng
        If Not Ob_A.Exists(Cell) Then
            Ob_A.Add Cell, Cell.Address
        End If
    Next
    For Each Vr In Ob_A.Keys
        If Not Vr = "" Then
            i = i + 1
            ReDim Preserve Ar(1 To i)
            Ar(i) = Vr
        End If
    Next
If i Then
Ali_Def = Ar()
End If
End Function

فكرت فى فكرة لم أستطع القيام بها وهى أننى قمت بإنشاء فورم بإستخدام الصفحات المتعددة ( MultiPage )

فكيف يمكن تطويع هذا الكود لأكثر من ورقة من خلال صفحات ( MultiPage ) **** أليك أخى الفاضل هذا المرفق 

لتوضيح ما أريد تحقيقة ***** برجاء اللإطلاع والإفادة وجزاكم الله تعالى خيرا

 

بيان الحالة-الاستاذ العيدروس.xlsb.xlsm