القائمة المنسدله الاوتوماتيكيه

[toyota]

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

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

ولكم جزيل الشكر وفي انتظار تفاعلكم 

Automatically Add to a Data Validation List.rar

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

أخي الحبيب تويوتا (سوق على مهلك سوق ..بكرة الدنيا تروق)

أولا .. في الملف المرفق تم تسمية النطاق من A1 إلى آخر خلية بها بيانات ..أي أن النطاق غير ثابت (ديناميكي) ، تم تسمية النطاق MyNames

=OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),1)

تم استخدام الدالة Offset ، والدالة بها بارمترات : الاول بداية المرجع للنطاق و هو هنا A1 ، والثانيوالثالث خاص بعدد صفوف الإزاحة وعدد أعمدة الإزاحة وهنا القيمة 0 ، حيث أن العمل داخل النطاق ولن تتم عملية الإزاحة ، والرابع ارتفاع النطاق وهنا تم استخدام الدالة Counta لتقوم بعد كل الخلايا التي بها بيانات ، والخامس عرض النطاق وهو 1 لأنه في عمود واحد فقط ..

وشرح الكود مرفق هنا

Private Sub Worksheet_Change(ByVal Target As Range)
    'تعريف المتغير
    Dim lReply As Long
    'هذا السطر لتجنب وقوع خطأ ، إذا تم التعامل مع أكثر من خلية لا يتم تنفيذ الكود
        If Target.Cells.Count > 1 Then Exit Sub
    'هنا التعامل مع هذه الخلية فقط والتي عنوانها D1
            If Target.Address = "$D$1" Then
    'إذا كانت الخلية الهدف فارغة لا يتم تنفيذ الكود ، ويتم الخروج من الإجراء الفرعي
                If IsEmpty(Target) Then Exit Sub
    'في حالة إذا كان الاسم المدخل في الخلية الهدف جديد يتم تنفيذ التالي ، وهنا اعتمد على دالة العد لمعرفة وجود الاسم من عدمه
                    If WorksheetFunction.CountIf(Range("MyNames"), Target) = 0 Then
    'إذا كان الاسم غير موجود بالقائمة يتم ظهور رسالة تفيد بذلك ، وبها اختيار نعم أو لا
                        lReply = MsgBox("Add " & Target & " to list", vbYesNo + vbQuestion)
    'إذا كان الاختيار بنعم
                            If lReply = vbYes Then
    'يتم من خلال هذا السطر إضافة الاسم الجديد في آخر النطاق في العمود الأول
                                Range("MyNames").Cells(Range("MyNames").Rows.Count + 1, 1) = Target
                            End If
                    End If
            End If
End Sub

[toyota]

الاستاذ الفاضل 

YasserKhalil

اشكر لك تعبك وتوضيحك الممتاز لهذاالكود 

ولكن المشكله هي اننياذا قمت بتطبيقه علي اي ملف اخر لا يعمل 

لا اعلم ما السبب 

[toyota]

استاذ ياسر هل من الممكن ان تساعدني في عمل قائمه منسدله مثل السابقه ولكن داخل فورم 

ولك جزيل الشكر 

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

ارفق ملفك أخي الحبيب لتجد المساعدة مني أو من غيري ...