كومبكس1 يستدعي كومبكس2 وهكذا الى اربعة كومبكس

[أبو قاسم]

ارجوا   المساعدة في   تعديل على الكود حيث كومبكس1 يستدعي كومبكس2 وكمبوكس 2 يستدعي كومبكس3  وكومبكس 3 يستدعي البيانات الى  تكست بوكس

اماكن.rar

[أبوبسمله]

اتفضل يا اخى راجع الموضوع ده

ان شاء الله تستفاد منه قائمة منسدله تعتمد على اخرى

بالتوفيق

[أبو قاسم]

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

[أبوبسمله]

اخى الفاضل

ان شاء الله احد الاخوه الافاضل يساعدك بما تريد وفقكك الله وجزاك الله كل خير

[رجب جاويش]

السلام عليكم

أخى الفاضل

جرب المرفق

 

اماكن.rar

[أبو قاسم]

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

[رجب جاويش]

جزاك الله خيرا أخى الفاضل على هذه الكلمات الطيبة

 

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

جزاكم الله خيراً أخي الحبيب رجب على هذا الحل الرائع

إليك حل آخر إثراءً للموضوع

ضع الكود التالي في حدث الفورم

Private Sub UserForm_Initialize()
    Dim Rng As Range
    Dim Dn As Range
    Dim Dic As Object
    With Sheets("Sheet1")
        Set Rng = .Range(.Range("C6"), .Range("C" & Rows.Count).End(xlUp))
    End With
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = vbTextCompare
    For Each Dn In Rng: Dic(Dn.Value) = Empty: Next
    ComboBox1.List = Application.Transpose(Dic.keys)
End Sub

Private Sub ComboBox1_Click()
    Call cValues(ComboBox1.Value, ComboBox2, 4) '4 Is Column Number
End Sub

Private Sub ComboBox2_Click()
    Call cValues(ComboBox2.Value, ComboBox3, 5) '5 Is Column Number
End Sub

Sub cValues(Txt As String, Obj As Object, Col As Integer)
    Dim Dn As Range
    Dim Rng As Range
    Dim Dic As Object

    Obj.Clear
    With Sheets("Sheet1")
        Set Rng = .Range(.Cells(6, Col), .Cells(Rows.Count, Col).End(xlUp))
    End With

    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1

    For Each Dn In Rng
        If Dn.Offset(, -1).Value = Txt Then
            If Not Dic.exists(Dn.Value) Then
                Dic(Dn.Value) = Empty
            End If
        End If
    Next Dn
    Obj.List = Application.Transpose(Dic.keys)
End Sub

قمت بإعادة تسمية الكومبوبوكس .. بدلاً من Sanf استخدمت الاسم الافتراضي ComboBox1 وبدلاً من Nawa استخدمت ComboBox2 والثالث جعلته بدلاً من ComboBox1 جعلته ComboBox3 .. كما قمت بإزالة الـ Row Source  لأول كومبوبوكس ..

تم الاستغناء عن الأكواد في حدث ورقة العمل .. فقط الكود في حدث الفورم هو الذي يقوم بالمهمة كاملة إن شاء الله

أرجو أن يكون الملف مقبول لديكم

تقبل تحياتي

 

Dependent ComboBox On UserForm YasserKhalil.rar

[أبو قاسم]

ممتاز جدأ جزاك الله خير لم يكتمل الاجراء  حيث لم يستدعى العمود F  في TextBox_mycode

[أبو قاسم]

تكملة كود الأستاذ ياسر خليل

[أبو قاسم]

في 2/15/2016 at 01:13, كاسر الامواج said:

ممتاز جدأ جزاك الله خير لم يكتمل الاجراء  حيث لم يستدعى العمود F  في TextBox_mycode

تكملة

[أبو قاسم]

8 ساعات مضت, كاسر الامواج said:

تكملة

 

في 2/15/2016 at 01:13, كاسر الامواج said:

اممتاز جدأ جزاك الله خير لم يكتمل الاجراء  حيث لم يستدعى العمود F  في TextBox_mycode

السلام عليكم ارجو تكملة 

[رجب جاويش]

السلام عليكم

أخى الحبيب / ياسر خليل

أخى الفاضل / كاسر الأمواج

بالنسبة للكود الرائع الخاص بأخى الحبيب ياسر

فيه نقطة واحدة وهى انه عند الاختيار من ComboBox2 يضع فى ComboBox3 كل الخلايا من العمود E  التى تقابل الاختيار

الموجود للـ ComboBox2  ( وليكن مستشفيات )  مثلا  بغض النظر عن الاختيار الموجود فى ComboBox1 الخاص باسم المحافظة

أى أنه يضع الاماكن المقابلة لكلمة مستشفى فى كل المحافظات وليست المحافظة المختارة فقط

وذلك بسبب الكود cValues

ولذلك عملت تعديل بسيط على الكود الرائع وسميته  cValuesR  لتدارك تلك النقطة الخاصة بـ ComboBox3

Sub cValuesR(Txt1 As String, Txt2 As String, Obj As Object, Col As Integer)
Dim Dn As Range
    Dim Rng As Range
    Dim Dic As Object

    Obj.Clear
    With Sheets("Sheet1")
        Set Rng = .Range(.Cells(6, Col), .Cells(Rows.Count, Col).End(xlUp))
    End With

    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1

    For Each Dn In Rng
        If Dn.Offset(, -1).Value = Txt1 And Dn.Offset(, -2).Value = Txt2 Then
            If Not Dic.exists(Dn.Value) Then
                Dic(Dn.Value) = Empty
            End If
        End If
    Next Dn
    Obj.List = Application.Transpose(Dic.keys)
End Sub

 

 

 

Dependent ComboBox On UserForm YasserKhalil.rar

تم تعديل فبراير 17, 2016 بواسطه رجب جاويش

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

بارك الله فيك وجزاك الله كل خير أخي ومعلمي المتميز رجب جاويش

بالفعل كلامك مضبوط ..لم أنتبه للكومبوبوكس الثالث .. عموماً الحمد لله إن فيه أساتذة كبار يصححوا لنا الخطأ

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

 

[أبو قاسم]

بارك الله فيكم جميعا وربنا يزيدكم علماً ورفعة في الدنيا والاخرة

[رجب جاويش]

أخى الحبيب /  ياسر خليل

جزاك الله كل خير على هذه الكلمات الطيبة

ورفع الله قدرك لهذا التواضع

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

 

 

 

 

[أبوبسمله]

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

وفقكم الله لما يحبه ويرضاه

[رجب جاويش]

شكرا جزيلا أخى الفاضل أبو بسمله

وجزاك الله خيرا على هذا الدعاء الطيب

 

[خالد الرشيدى]

السلام عليكم

 استاذنا الحبيب / ياسر خليل            ربنا يكرمك   .. ابداع مستمر 

تحياتى للاستاذ القدير / رجب جاويش

اخى الكريم انصحك بتفقد الرابط التالى حيث يتناول شرح الكود المستخدم    .. تقبلوا مرورى وتحياتى

http://www.officena.net/ib/topic/63175-تعديل-في-الأكواد-تعبئة-الكومبو-بقيم-فريدة-باستخدام-scriptingdictionary/?_fromLogout=1