طلب قائمة منسدلة بكود

[ياسر أحمد الشيخ]

السلام عليكم ورحمه الله وبركاته

أريد كود لعمل قائمة منسدلة مرتبة أبجدياً وبدون فراغات

بشرط أن يتم تحديثها عند فتح الملف

انظر المرفق للتطبيق عليه

suppliers3_LIST.rar

[ياسر أحمد الشيخ]

للرفع أخوانى

[عبدالله باقشير]

السلام عليكم

أريد كود لعمل قائمة منسدلة مرتبة أبجدياً وبدون فراغات

بشرط أن يتم تحديثها عند فتح الملف

يتم التعديل عند فتح الملف

وايضا عبر زر

Option Explicit

Option Compare Text


Const ch As String * 1 = "^"


Sub kh_Start()

Dim LastRow As Long

With Sheets("List")

    LastRow = .Range("A2").CurrentRegion.Rows.Count

    .Range("A2:C" & LastRow).ClearContents

End With

Addliste Range("Data").Columns(3), Sheets("List").Range("A2")

Addliste Range("Data").Columns(4), Sheets("List").Range("B2")

Addliste Range("Data").Columns(5), Sheets("List").Range("C2")

End Sub


Sub Addliste(ColList As Range, MyCol As Range)

Dim MyArr, myAry, sp

Dim Myitem As String

Dim myRank As String

Dim kh_Test As Boolean

Dim R As Long, i As Long, ii As Long

'========================

With ColList

    For R = 2 To .Rows.Count

        If Not IsEmpty(.Cells(R, 1)) Then

            Myitem = Trim(.Cells(R, 1)) & ch

            If InStr(ch & MyArr, ch & Myitem) = 0 Then

                MyArr = MyArr & Myitem

            End If

        End If

    Next

End With

If IsEmpty(MyArr) Then Exit Sub

'========================

MyArr = Left(MyArr, Len(MyArr) - 1)

myAry = kh_ListSortInArray(Split(MyArr, ch))

'========================

For Each sp In myAry

    MyCol.Offset(ii, 0).Value = sp

    ii = ii + 1

Next

End Sub

'-----------------------------------------------------------------

'-----------------------------------------------------------------

Function kh_ListSortInArray(myArray)

    Dim myRank As String

    Dim kh_Test As Boolean

    Dim i As Long

    Do

        kh_Test = False

        For i = LBound(myArray) To UBound(myArray) - 1

            If myArray(i) > myArray(i + 1) Then

                    myRank = myArray(i)

                    myArray(i) = myArray(i + 1)

                    myArray(i + 1) = myRank

                kh_Test = True

            End If

        Next i

    Loop While kh_Test = True

    kh_ListSortInArray = myArray

    Erase myArray

End Function

شاهد المرفق 2007

suppliers3_LIST1.rar

[ياسر أحمد الشيخ]

شكرا أخى خبور على اهتمامك وردك الجميل

كود أكثر من رائع

ولكنى قد ذكرت أخى أننى أريد عمل قائمة منسدلة Validation List

وليس قائمة عادية

السلام عليكم ورحمه الله وبركاته

أريد كود لعمل قائمة منسدلة مرتبة أبجدياً وبدون فراغات

بشرط أن يتم تحديثها عند فتح الملف

انظر المرفق للتطبيق عليه

أرجو اهتمامك أخى الكريم

[عبدالله باقشير]

شكرا أخى خبور على اهتمامك وردك الجميل

كود أكثر من رائع

ولكنى قد ذكرت أخى أننى أريد عمل قائمة منسدلة Validation List

وليس قائمة عادية

السلام عليكم ورحمه الله وبركاته

أريد كود لعمل قائمة منسدلة مرتبة أبجدياً وبدون فراغات

بشرط أن يتم تحديثها عند فتح الملف

انظر المرفق للتطبيق عليه

أرجو اهتمامك أخى الكريم

حمل المرفق2003 -2007

من الرابط التالي

http://getfile4.posterous.com/getfile/files.posterous.com/khboor/A6xn96bT9HQDKcGSUF7cQuhwmvs63LQEE0NrbJ9ncP2sSbbctKqOCVitPXMr/suppliers3_LIST2.rar