تجمعية تحت عنوان تغذية القائمة المنسدلة خاصة بالفورم (ComboBox) بمدى ديناميكي

[الجموعي]

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

أحبائي وأساتذتي الأفاضل

أقدم لك هذه التجميعية البسيطه ليستفيد بها المبتدئ والمحترف

تجمعية تحت عنوان

 

تغذية القائمة المنسدلة خاصة بالفورم (ComboBox) بمدى ديناميكي

 

أولا: نقوم بإنشاء فورم وندرج به قائمة منسدلة (ComboBox1)

ثانيا : نفتح محرر  الاكواد View Code)

ثالثا: من نافذه المحرر نختر حدث بداية التشغيل الفورم UserForm_Initialize

Private Sub UserForm_Initialize()

End Sub

 نقوم بوضع المتغير التالي الخاص بتحديد ورقة العمل وهم أمر مهم جدا

Private Sub UserForm_Initialize()
Dim ws As Object
Set ws = ThisWorkbook.Sheets(1)
ws.Select
End Sub

نأتي الأن إلى الأكواد الخاصة بتغذية القائمة المنسدلة

 

ملاحظه جميع الأكواد الخاصة بالتغذية أنا إخترت العمود الأول وبداية التغذية من الخلية A2 ولكم حرية التغيير

 

الكود رقم 1

Private Sub UserForm_Initialize()
Dim ws As Object
Set ws = ThisWorkbook.Sheets(1)
ws.Select
Range("A2", Range("A" & Rows.Count).End(xlUp)).Name = "Dynamic"
Me.ComboBox1.RowSource = "Dynamic"
End Sub

الكود رقم 2

Private Sub UserForm_Initialize()
Dim ws As Object
Set ws = ThisWorkbook.Sheets(1)
ws.Select
Me.ComboBox1.RowSource = Range("B2", Range("B65536").End(xlUp)).Address
End Sub

الكود رقم 3

Private Sub UserForm_Initialize()
Dim ws As Object
Set ws = ThisWorkbook.Sheets(1)
ws.Select
Me.ComboBox1.RowSource = ("A2:A") & ws.Cells(Rows.Count, "A").End(xlUp).Row
End Sub

الكود رقم 4

Private Sub UserForm_Initialize()
Dim ws As Object
Set ws = ThisWorkbook.Sheets(1)
ws.Select
Me.ComboBox1.List = Range("A2:A" & Cells(Application.Rows.Count, 1).End(xlUp).Row).Value
End Sub

 الكود رقم 5

Private Sub UserForm_Initialize()
Dim ws As Object
Set ws = ThisWorkbook.Sheets(1)
ws.Select
Dim FR As Integer, LR As Integer
 With ws
    LR = .Range("A2").End(xlDown).Row
    For FR = 2 To LR
        Me.ComboBox1.AddItem .Range("A" & FR)
    Next FR
 End With
End Sub

الكود رقم 6

Private Sub UserForm_Initialize()
Dim ws As Object
Set ws = ThisWorkbook.Sheets(1)
ws.Select
Dim R As Integer
With ws
      For R = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
            If .Range("A" & R) <> "" Then
            Me.ComboBox1.AddItem .Range("A" & R)
            End If
      Next R
   End With
End Sub

الكود رقم 7

Private Sub UserForm_Initialize()
Dim ws As Object
Set ws = ThisWorkbook.Sheets(1)
ws.Select
Dim LR As Long
 LR = ws.Cells(Rows.Count, "A").End(xlUp).Row
 myList = ws.Range("A2:" & "A" & LR)
 Me.ComboBox1.List = myList
End Sub

الكود رقم 8

Private Sub UserForm_Initialize()
Dim ws As Object
Set ws = ThisWorkbook.Sheets(1)
ws.Select
Dim LR As Long
    LR = ws.Range("A" & Rows.Count).End(xlUp).Row
    Set myList = ws.Range("A2:A" & LR)
    Me.ComboBox1.List = myList.Value
End Sub

الكود رقم 9

Private Sub UserForm_Initialize()
Dim ws As Object
Set ws = ThisWorkbook.Sheets(1)
ws.Select
Dim LR As Long
    With ComboBox1
         LR = ws.Cells(Rows.Count, 1).End(xlUp).Row
        .List = ws.Range(ws.Cells(2, 1), ws.Cells(LR, 1)).Value
    End With
End Sub

الكود رقم 10

Private Sub UserForm_Initialize()
Dim ws As Object
Set ws = ThisWorkbook.Sheets(1)
ws.Select
Dim myList As Range
For Each myList In ws.Range("A2").SpecialCells(xlConstants)
    With Me.ComboBox1
   .AddItem myList.Value
   .List(.ListCount - 1, 1) = myList.Offset(0, 1).Value
End With
Next
End Sub

الكود رقم 11

Private Sub UserForm_Initialize()
Dim ws As Object
Set ws = ThisWorkbook.Sheets(1)
ws.Select
 Dim i As Integer, iMin As Integer, iMax As Integer
       iMin = 2: iMax = Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
    For i = iMin To iMax
      ComboBox1.List = Range(Cells(iMin, 1), Cells(iMax, 1)).Value
    Next i
End Sub

 الكود رقم 12

من إدارة الأسماء نختر جديد

الإسم انت حر فيما تختار

أنا إخترت

MyRange

في خانة يشير إلى نقوم بوضع هذه المعادلة

=OFFSET(Sheet1!$A$2;;;COUNTA(Sheet1!$A$2:$A$10000);1)

في الفورم نقوم بوضع الكود التالي

Private Sub UserForm_Initialize()
Dim ws As Object
Set ws = ThisWorkbook.Sheets(1)
ws.Select
Me.ComboBox1.RowSource = "Myrange"
End Sub

الكود رقم 13

 

كود تغذية القائمة المنسدلة بدون فراغات

Private Sub UserForm_Initialize()
Dim ws As Object
Set ws = ThisWorkbook.Sheets(1)
ws.Select
Dim cell As Range
    With ws
        For Each cell In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
            If Not IsEmpty(cell) Then ComboBox1.AddItem cell.Value
        Next cell
    End With
End Sub

الكود رقم 14

 

كود تغذية القائمة المنسدلة بدون فراغات وبدون تكرار

Private Sub UserForm_Initialize()
Dim ws As Object
Set ws = ThisWorkbook.Sheets(1)
ws.Select
Dim I As Integer
Dim Valeurs As Variant
Dim sDic As Object
    Set sDic = CreateObject("Scripting.Dictionary")
    With ws
        Valeurs = .Range("A2:A100").Value
        For I = LBound(Valeurs) To UBound(Valeurs)
            If Not IsEmpty(Valeurs(I, 1)) Then sDic(Valeurs(I, 1)) = ""
        Next I
    End With
    If IsArray(Valeurs) Then Me.ComboBox1.List = sDic.keys
End Sub

وفي الأخير أتمنى هذه التجمعية المتواضعة أن تفيدكم

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

 

أستاذي القدير وحقك عليا

 

تقبلو تحياتي

 

لا تنسونا بخالص دعائكم

 

 

[عبدالباري البنا]

اخى العزيز

الجموعى

ما شاء الله عليك ...مبدع 

والابداع عادة من عاداتك الجميله

فاعمالك كلها ذات مذاق ورحيق يحمل اسمك 

دائما للامام ...

[الجموعي]

 

اخى العزيز

الجموعى

ما شاء الله عليك ...مبدع 

والابداع عادة من عاداتك الجميله

فاعمالك كلها ذات مذاق ورحيق يحمل اسمك 

دائما للامام ...

 

أخي الفاضل / عبد الباري البنا

بارك الله فيك على المرور الكريم وتشجيعك الدائم

تقبل تحياتي

[KHMB]

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

اخي الجموعي جزاك الله خير نستطيع الاستفادة فمن هذه الاكواد في اشياء غير القائمة المنسدلة وهي كثيره مثال المقارنة والترحيل وغيره الكثير

وياليتك قمت بوضع هذه الاكواد في مصنف واحد وكل صفحة تمثل واحد من البنود المذكورة

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

[Akram Galal]

اخى العزيز

الجموعى

ممكن ارفاق ملف للتوضيح والإستفادة للجميع

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

[الجموعي]

 

اخى العزيز

الجموعى

ممكن ارفاق ملف للتوضيح والإستفادة للجميع

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

 

 

تفضل المرفق به مثال واحد للتوضيح وهكذا مع بقية الأكواد

نسخ لصق للكود

ComboBox-Exemple.rar

[الجموعي]

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

اخي الجموعي جزاك الله خير نستطيع الاستفادة فمن هذه الاكواد في اشياء غير القائمة المنسدلة وهي كثيره مثال المقارنة والترحيل وغيره الكثير

وياليتك قمت بوضع هذه الاكواد في مصنف واحد وكل صفحة تمثل واحد من البنود المذكورة

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

أخي الحبيب

بارك الله فيك على المرور

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

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

وسبق أن طرحت موضوع الترحيل بخاصية TAG

+إضافة في نفس الموضوع للأستاذ القدير/ إبن مصر

بالنسبة للمقارنة  وضح لي بمثال لأساعدك

[ياسر خليل أبو البراء]

بارك الله فيك أخي الجموعي على هذه التجميعة الرائعة والمفيدة جدا

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

تقبل تحياتي

[Akram Galal]

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

[الزباري]

جزيت خيراً وبارك الله فيك.. لي تجربة في التغذية الديناميكية سأرفقها لكم لاحقاً بإذن الله.

[KHMB]

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

الله يرضى عليك ووالديك دنيا وآخره

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

بارك الله فيك

[ابو حمادة]

في 06 فبراير, 2015 at 17:57, الجموعي said:

 

تفضل المرفق به مثال واحد للتوضيح وهكذا مع بقية الأكواد

نسخ لصق للكود

ComboBox-Exemple.rar

استاذي الفاضل اتمنى عمل ملف به 3 ( ComboBox1  ) لاختيار القائمة المنسدله ارج الاطلاع علي الملف المرفق

ComboBox-Exemple.rar

[الجموعي]

منذ ساعه, ابو حمادة said:

استاذي الفاضل اتمنى عمل ملف به 3 ( ComboBox1  ) لاختيار القائمة المنسدله ارج الاطلاع علي الملف المرفق

ComboBox-Exemple.rar

بالنسبة لطلبك الاول تفضل

Private Sub UserForm_Initialize()
Dim ws As Object
Set ws = ThisWorkbook.Sheets(1)
ws.Select

    Dim I As Integer
    Dim Valeurs1, Valeurs2, Valeurs3 As Variant
    Dim sDic1, sDic2, sDic3 As Object
    Set sDic1 = CreateObject("Scripting.Dictionary")
    Set sDic2 = CreateObject("Scripting.Dictionary")
    Set sDic3 = CreateObject("Scripting.Dictionary")
'=============================خاص بالكمبوبوكس3===============================
    With ws
        Valeurs1 = .Range("A2:A1000").Value
        For I = LBound(Valeurs1) To UBound(Valeurs1)
            If Not IsEmpty(Valeurs1(I, 1)) Then sDic1(Valeurs1(I, 1)) = ""
        Next I
    End With
    If IsArray(Valeurs1) Then Me.ComboBox1.List = sDic1.keys
'=============================خاص بالكمبوبوكس2===============================
    With ws
        Valeurs2 = .Range("B2:B1000").Value
        For I = LBound(Valeurs2) To UBound(Valeurs2)
            If Not IsEmpty(Valeurs2(I, 1)) Then sDic2(Valeurs2(I, 1)) = ""
        Next I
    End With
    If IsArray(Valeurs2) Then Me.ComboBox2.List = sDic2.keys
'=============================خاص بالكمبوبوكس3===============================
    With ws
        Valeurs3 = .Range("C2:C1000").Value
        For I = LBound(Valeurs3) To UBound(Valeurs3)
            If Not IsEmpty(Valeurs3(I, 1)) Then sDic3(Valeurs3(I, 1)) = ""
        Next I
    End With
    If IsArray(Valeurs3) Then Me.ComboBox3.List = sDic3.keys
End Sub

 

[أبوبسمله]

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

تقبل تحياتى

[ياسر خليل أبو البراء]

بارك الله فيك أخي الغالي الجموعي وعوداً حميداً

والله اشتقت لأعمالك الرائعة .. ننتظر منك موضوع جديد كهدية بمناسبة رجوعك للمنتدى

تقبل تحياتي

 

[ابو حمادة]

شكرا ليك اخي الفاضل استاذ  ( الجموعي )

علي مجهودك الرائع

اتمنى الطلب الثاني في الملف المرفق