كود للإختيار من قائمة معينة عند الضغط عليها مرتين مطلوب اكثر من قائمة

[احمد ابوزيزو]

السادة الاعضاء

دمتم بالف الف خير

الحاقا لموضوع 

كود للإختيار من قائمة معينة عند الضغط عليها مرتين

يرجي التفضل بالاضافة للموضوع بعمل قائمتين للاختيار

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

دبل كليك.xlsx

[ابراهيم الحداد]

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

ضع الكود الاول فى موديول مستقل

Sub GetUniqueValues()
Dim Rng As Range, Rng1 As Range
Set Rng = Sheet2.Range("C5:C" & Sheet2.Range("C" & Rows.Count).End(3).Row + 1)
Set Rng1 = Sheet2.Range("E5:E" & Sheet2.Range("E" & Rows.Count).End(3).Row + 1)
Sheet1.Range("B2:B" & Sheet1.Range("B" & Rows.Count).End(3).Row).Name = "MyRange"
Sheet1.Range("E2:E" & Sheet1.Range("E" & Rows.Count).End(3).Row).Name = "MyRange1"
With Rng.Validation
.Delete
.Add xlValidateList, xlValidAlertStop, xlBetween, "=MyRange"
End With
With Rng1.Validation
.Delete
.Add xlValidateList, xlValidAlertStop, xlBetween, "=MyRange1"
End With
End Sub

اما هذا الكود فيوضع فى فى حدث الورقة "الحافز"

لا تنسى حفظ الملف بامتداد آخر حتى تستطيع حفظ الكود

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 3 And Target.Row > 4 Or Target.Column = 5 And _
Target.Row > 4 And Target.Row > 4 Then GetUniqueValues
End Sub

 

 

[احمد ابوزيزو]

كل الشكر للاستاذ @هاني محمد

للتفضل بالمرور الكريم 

فقط اذكر ه نعنوان الطلب وهو ( الحاقا لموضوع كود ....) وسبب الموضوع الجديد هو طلب قائمتين وليس قائمة واحده فقط 

السادة الاعضاء

دمتم بالف الف خير

الحاقا لموضوع 

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

التفضل بالرد 

ولكن ليس هذا هو المطلوب بالتحديد 

المطلوب كما جاء بالموصوع الاصلي الذي تم الاشاره اليه والحاقا به 

هو ظهور FORM تظهر به القائمة ليتم الاحتيار المباشر منها او البحث عن القيمة المطلوبة ثم الاختيار

مرفق صورة ملف الموضوع الاصلي

 

[Ali Mohamed Ali]

تفضل لك ما طلبت

دبل كليك1.xlsm

[احمد ابوزيزو]

كل الشكر 

للسادة الاعضاء 

وشكر خاص 

@Ali Mohamed Ali