عدم ظهور بنود بالقائمة المنسدلة الفرعية اذا كانت غير مرتبطة بالكمبوبوكس الأساسى

[مهند محسن]

السلام عليكم  أساتذتى الكرام -ارجو التكرم والتلطف على مساعدتى في حل هذه المشكلة

المطلوب : عندما اقوم باختيار اى صنف من الكمبوبوكس ويكون له بنود
بالقائمة المنسدلة يوضح لى ذلك ,وعلى العكس اذا قمت بإختيار اى 
بند اخر من الكمبوبوكس ليس له مقابل فى القائمة الفرعية بالقائمة المنسدلة
فلابد من جعل خلية القائمة المنسدلة فارغة وليس بها اية بيانات

ولكم منى جزيل الشكر -بارك الله فيكم جميعا 
 

ComboBox With Drop List.xls

تم تعديل أبريل 23, 2019 بواسطه مهند محسن

[احمد بدره]

ممكن يكون الرابط يفيدك

 

[مهند محسن]

أشكرك استاذ أحمد بارك الله فيك

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

جعل الله ما تقدمه فى ميزان حسناتك

[مهند محسن]

للرفع أكرمكم الله

[سليم حاصبيا]

جرب هذا الملف

الكود

Option Explicit
Private Sub ComboBox1_Change()
fill_val_list
End Sub
'===============================================
Sub fill_val_list()
  Dim my_rg As Range
  Dim i%
  Dim st$: st = Sheets("Drop List").[b8]
  Dim arr
  Sheets("Drop List").Range("b10").Validation.Delete
 On Error GoTo No_Items
  Set my_rg = ActiveWorkbook.Names(st).RefersToRange
  ReDim arr(1 To my_rg.Cells.Count)
   With Sheets("Drop List").Range("b10").Validation
    For i = 1 To my_rg.Cells.Count
     arr(i) = my_rg.Cells(i)
    Next
     .Add 3, , , Join(arr, ",")
  End With
  Exit Sub
No_Items:
 MsgBox "Wrong range", 64
End Sub
'==========

 

ComboBox With Drop List.xlsm

[احمد بدره]

دائمًا مبدع أستاذنا الفاضل / سليم ونحن نتعلم منك الكثير  بارك الله فيك

ولي سؤال ماذا لو تم تعديل الكود  بإضافة 
Range("b10") = ""

في بداية الكود ليتم مسح الخلية b10 قبل البدء بالعمل 

فيكون الكود

Option Explicit
Private Sub ComboBox1_Change()
fill_val_list
End Sub
'===============================================
Sub fill_val_list()
Range("b10") = ""
  Dim my_rg As Range
  Dim i%
  Dim st$: st = Sheets("Drop List").[b8]
  Dim arr
  Sheets("Drop List").Range("b10").Validation.Delete
  On Error GoTo No_Items
   Set my_rg = ActiveWorkbook.Names(st).RefersToRange
  ReDim arr(1 To my_rg.Cells.Count)
   With Sheets("Drop List").Range("b10").Validation
    For i = 1 To my_rg.Cells.Count
     arr(i) = my_rg.Cells(i)
    Next
        .Add 3, , , Join(arr, ",")
  End With
    Exit Sub
     
No_Items:
' MsgBox "Wrong range", 64

End Sub
'======================================

 

 

[مهند محسن]

حقا دائما مبدع استاذى الكريم سليم

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

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

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

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

تم تعديل أبريل 23, 2019 بواسطه مهند محسن

[وجيه شرف الدين]

بارك الله فيكم استاذ سليم وجعلكم الله دائما مصدر للعطاء

[سليم حاصبيا]

تم معالجة الامر بالتعديل على  الكود

Option Explicit
Private Sub ComboBox1_Change()
fill_val_list
If Sheets("Drop List").Range("b10") = vbNullString Then
Exit Sub
End If
End Sub
'===============================================
Sub fill_val_list()
  Dim my_rg As Range
  Dim i%
  Dim st$: st = Sheets("Drop List").[b8]
  Dim arr
  Application.EnableEvents = False
  Sheets("Drop List").Range("b10").Validation.Delete
 On Error GoTo No_Items
  Set my_rg = ActiveWorkbook.Names(st).RefersToRange
  ReDim arr(1 To my_rg.Cells.Count)
   With Sheets("Drop List").Range("b10").Validation
    For i = 1 To my_rg.Cells.Count
     arr(i) = my_rg.Cells(i)
    Next
     .Add 3, , , Join(arr, ",")
  End With
  Sheets("Drop List").Range("b10") = arr(1)
  Application.EnableEvents = True
  Exit Sub
No_Items:
  
Sheets("Drop List").Range("b10") = vbNullString
Sheets("Drop List").Range("b8") = vbNullString
Sheets("Drop List").Range("b10").Validation.Delete

 Application.EnableEvents = True
End Sub
'======================================


Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$B$10" And Target.Value = vbNullString Then
 MsgBox "Wrong range", 64
 End If
 Application.EnableEvents = True
End Sub

الملف الجديد

 

ComboBox With Drop List_new.xlsm

[مهند محسن]

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

ولكن عندما يتم اختيار البند الذى له قائمة فرعية من الكمبوبوكس يظهر لى اول بند من القائمة الفرعية وعندما أحاول تغييره او اختيار بند اخر لا يتم الإختيار

علاوة على ذلك عندما يتم اختيار بند من الكمبوبوكس ليس له بيانات في القائمة الفرعية بالقائمة المنسدلة يتم حذف الذى تم اختياره من الكمبوبوكس ويعطينى رسالة  Wrong Range

ساعدونى بارك الله فيكم جميعا

[مهند محسن]

للرفع بارك الله فيكم جميعا

[احمد بدره]

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

 

ComboBox With Drop List_new.xlsm

[مهند محسن]

ممتاز أستاذ أحمد  تعديل رائع-بارك الله فيك

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

[احمد بدره]

جرب هذا التعديل ComboBox With Drop List_new.xlsm

[مهند محسن]

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

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

حقا هذا هو المطلوب