طريقة تحرير جداول إدارة الأسماء في الإكسل

[AMIRBM]

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

طلب مساعدة إخواني الكرام في جدول إدارة الأسماء في الإكيل . الجداول حسب عدد الموظفين الذي أريد .وشكرا

منظومة-الشؤون-الادارية أوفيسنا.xlsm

[AMIRBM]

كلمة السر   admin

1989

admin

1989

[محمد هشام.]

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

اخي @AMIRBM  

1) الأفضل هو تجاهل الصفوف الفارغة في عمود G بدلا من تقييد العرض بـ  51 صف فقط

لأنك بذلك تمنع عرض أي بيانات جديدة تضاف لاحقا بعد الصف 51 أي إدخال جديد لن يظهر في الـ ListBox الكود يصبح محدودا وغير ديناميكي

2) بعد معاينة الملف لاحظت انك اسم الجدول على ورقة العمل باسم Tableau5 بينما الكود يشير إلى Tableau1 وهذا سيؤدي حتما إلى ظهور خطأ عند التشغيل لأن الكود يبحث عن جدول غير موجود

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

3) إذا كنت متأكد أن تقييد العرض على 51 صف فقط هو المطلوب ويراعي ظروف عملك يمكننا تعديل الكود ليقوم بعرض أول 51 صف من البيانات الفعلية فقط

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

هل ترغب أن أعدل لك الكود بحيث يعرض فقط أول 51 صف غير فارغ في العمود G ؟
أو تفضل التعديل الديناميكي الذي يعرض كل الصفوف الفعلية ويتجاهل الفراغات ؟

[AMIRBM]

شكرا أستاذ بارك الله فيك وجزاك الله خيرا

أرغب أن تعدل لك الكود بحيث يعرض فقط أول 51 صف غير فارغ في العمود G

[محمد هشام.]

ادن يمكننا استخدام الطريقة التالية 

Public Property Get WS() As Worksheet: Set WS = Sheets("DbSheet"): End Property
Private Function ColArr(fromNum As Long, toNum As Long) As Variant
    Dim arr() As Long, i As Long
    ReDim arr(0 To toNum - fromNum)
    For i = 0 To UBound(arr): arr(i) = fromNum + i: Next i
    ColArr = arr
End Function
Private Sub UserForm_Initialize()
    Dim i As Long, j As Long, d As Object
    colVisu = ColArr(1, 7)
    Dim maxRow As Long: maxRow = 51 <=====   عدد الصفوف الظاهرة على الليست بوكس 
    Dim lastRow As Long: lastRow = WS.Cells(WS.Rows.Count, 7).End(xlUp).Row
    If lastRow > maxRow Then lastRow = maxRow
    Set WsRng = WS.Range("A2:G" & lastRow)
    TblBD = WsRng.Value
    OnRng = WsRng.Rows.Count
    ReDim cnt(1 To OnRng, 1 To UBound(colVisu) + 2)

    For i = 1 To OnRng
        For j = 0 To UBound(colVisu)
            cnt(i, j + 1) = TblBD(i, colVisu(j))
            If IsDate(cnt(i, j + 1)) Then cnt(i, j + 1) = Format(cnt(i, j + 1), "dd/mm/yy")
        Next j
        cnt(i, UBound(colVisu) + 2) = i + 1
    Next i

    With Me.ListBox1
        .ColumnCount = UBound(colVisu) + 2
        .ColumnWidths = "90;90;90;90;120;90;90;0"
        .List = cnt
    End With
    Me.ComboBox1.List = Application.Transpose(WS.Range("A1:G1").Value)
    Me.ComboBox1.ListIndex = 0
    Me.B.Caption = "فلترة ب: " & Me.ComboBox1
    Me.A.Caption = "إختيار عمود البحث"

    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(cnt): d(cnt(i, 1)) = "": Next i
    Me.ComboBox2.List = d.Keys: Me.ComboBox2 = "*"

    EnteteListBox
    UpLabels
    Hrlabel
    Me.tCount.Caption = "عدد الموظفين / " & ListBox1.ListCount
End Sub

 

 

منظومة-الشؤون-الادارية 2.xlsm

تم تعديل مايو 24 بواسطه محمد هشام.
تنظيم الكود

[AMIRBM]

شكرا أستاذ بارك الله فيك وجزاك الله خيرا

[محمد هشام.]

العفو أخي @AMIRBM

يمكنك الآن إعادة تحميل النسخة المحدثة من الملف من خلال المشاركة السابقة

[AMIRBM]

شكرا أستاذ بارك الله فيك وجزاك الله خيرا