مساعدة في برمجة زر تصفير للقائمة المنسدلة

[talal baghdadi]

السلام عليكم 

مساعدة في برمجة لعمل زر من اجل تصفير القائمة منسدلة من البيانات

حسب المرفق ادناه 

في جدول اشعار الخروج اضيف المادة التي سوف تخرج من عندي عن طرق القائمة المنسدلة واضع رقم الموزنة يدوي

احتاج الى طريقة يتم مسح بيانات من القائمة المنسدلة بكبسة زر 

انا وضعت في القائمة المنسدلة في اخر خيار فراغ 

بسبب ضغط عملي اعطي اشعارات بالمئات ولكن يضيع الوقت كثير لتفريغ الخانات ووضع بيانات جديدة 

اشعار اخراج طلال.xlsx

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

ربما ينفع هذا الكود

Option Explicit
Sub del_Data_Val()
Range("Data_Val").Validation.Delete
'++++++++++Optional+++++++++++
Range("Data_Val").Value = ""
End Sub
'++++++++++++++++++++++++++++++++++++++
Sub Ad_Data_Val()
With Range("Data_Val").Validation
.Delete
.Add 3, Formula1:="=Source_Rg"
End With
'++++++++++Optional+++++++++++
 Range("Data_Val") = ""
End Sub

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

  او لا  بمسح ما يوجد داخل المربع الاحمر  حسب  هذه الصورة

الملف مرفق

Talal.xlsm

[talal baghdadi]

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

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

تم معالجة الامر

1- عندما تضغط على الزر Choose to delete تظهر لك رسالة تحتار منها رقم النظاق الذي تريد مسجة 
       الأرقام مسجلة الى جانب كل نطاق

2-  الزر Add Data Val ما زال يقوم بعمله  ====>>   ادراج القوائم المنسدلة (يستعمل في حال التعديل على مصدر البيانات لهذه القوائم)

Option Explicit

Sub Ad_Data_Val()
With Range("Data_Val").Validation
.Delete
.Add 3, Formula1:="=Source_Rg"
End With
End Sub
'++++++++++++++++++++++++++++++++++++++++
Sub del_special_range()
Dim InpB
InpB = Application.InputBox("Choose to Delete from 1 to 6:" & Chr(10) & _
 "1-  " & Range("Data_Val").Areas(1).Address(0, 0) & Chr(10) & _
 "2-  " & Range("Data_Val").Areas(2).Address(0, 0) & Chr(10) & _
 "3-  " & Range("Data_Val").Areas(3).Address(0, 0) & Chr(10) & _
 "4-  " & Range("Data_Val").Areas(4).Address(0, 0) & Chr(10) & _
 "5-  " & Range("Data_Val").Areas(5).Address(0, 0) & Chr(10) & _
 "6-  " & Range("Data_Val").Areas(6).Address(0, 0))
 If Val(InpB) <= 0 Then
  MsgBox "You Must Choose Only Number from 1 to 6"
  Exit Sub
 End If
 
 If InpB <= 6 And InpB >= 1 Then
  InpB = Int(InpB)
  Range("Data_Val").Areas(InpB) = vbNullString
  Else
  MsgBox "You Must Choose Only Number from 1 to 6"
   End If
End Sub

الملف الجديد مرفق

 

Talal_2.xlsm

[أحمد يوسف]

 talal baghdadi

أين الضغط على الإعــــجـــــاب لهذه الإجابة الممتاز لأستاذنا الكبير سليم ؟!!!💙