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

[الدكتور خضر الرجبي]

يتماشى هذا الموضوع مع نسخة Access2000 وما بعدها.

يستفاد من هذا الموضوع معرفة طريقة إضافة مجموعة من العناصر بعد ترتيبها أبجديا إلى مربع تحرير وسرد (combo box) برمجيا باستخدام (VBA).

المشكلة : إذا تم إضافة مجموعة من العناصر برمجيا إلى مربع التحرير والسرد فإنها تظهر حسب ترتيب الإضافة وليس أبجديا.

إحدى طرق الحل:

1. إضافة العناصر إلى مصفوفة (Array)

2. وبعدها ترتيب المصفوفة

3. ومن ثم إضافة عناصر المصفوفة المرتبة إلى مربع التحرير والسرد

ولننفذ هذه الخوارزمية نقوم بالخطوات التالية:

1. ننشأ مربع التحرير والسرد ونسميه TheCombo في خاصية الاسم (Name)

2. نختار في خاصية نوع مصدر الصف (Row Source Type) قائمة الحقول (Value List)

3. نضع في إطار (VBA) الكود التالي :

Option Compare Database
Dim sA(50) As String
Private Sub Form_Load()
Dim obj As AccessObject
Dim proj As CurrentProject
Dim I As Byte
' Step1 : fill the array with the wanted items
Set proj = Application.CurrentProject
I = 0
For Each obj In proj.AllForms
  sA(I) = obj.Name
  I = I + 1
Next obj
' Step2 : Sort the array
Sort I - 1
' Step3 : add to the combo box items in the sorted array
For x = 0 To I - 1
  Me.TheCombo.AddItem (sA(x))
Next
End Sub
Sub Sort(Items As Integer)
Dim L, M As Integer
Dim sT As String
MsgBox sA(0)
For L = 0 To Items
 For M = 0 To Items - 1
 If StrComp(sA(M), sA(M + 1), vbTextCompare) = 1 Then
   sT = sA(M)
   sA(M) = sA(M + 1)
   sA(M + 1) = sT
  End If
 Next
Next
End Sub

ملاحظة (1): العناصر التي تم تحميلها إلى المصفوفة هي أسماء النماذج التي في القاعدة (AllForms) ويمكن تحميل أسماء عناصر مختلفة من القاعدة فقط بتغيير (AllForms). ملاحظة (2): طريقة الترتيب تصاعديا وإذا أردنا الترتيب تنازليا فالتغيير يكون فقط في إشارة المساواة نحولها إلى عدم المساواة كالتالي:

If StrComp(sA(M), sA(M + 1), vbTextCompare) <> 1 Then

الخلاصة: تم ترتيب عناصر مصفوفة وإضافة عناصرها إلى مربع تحرير وسرد برمجيا.

[أبو هادي]

السلام عليكم

وهذه نفس الفكرة باستخدام إجراء فرز سريع بإسم QuickSort :

Sub QuickSort(vArray)
  Dim Min As Integer, Max As Integer
  Dim i As Integer, j As Integer
  Dim x As Variant, y As Variant
  
  Min = LBound(vArray)
  Max = UBound(vArray)
  
  i = Min
  j = Max
  x = vArray((Min + Max) / 2)
  Do
    Do While vArray(i) < x: i = i + 1: Loop
    Do While vArray(j) > x: j = j - 1: Loop
    If i <= j Then
      y = vArray(i)
      vArray(i) = vArray(j)
      vArray(j) = y
      i = i + 1
      j = j - 1
    End If
    If Min < j Then Call QuickSort(vArray)
    If i < Max Then Call QuickSort(vArray)
  Loop Until i > j
End Sub

Private Sub Form_Load()
  Dim prt As Printer
  Dim Index As Integer
  Dim PrnNames
  
  ReDim PrnNames(0 To Application.Printers.Count - 1) As String
  Index = -1
  
  For Each prt In Application.Printers
    Index = Index + 1
    PrnNames(Index) = prt.DeviceName
  Next
  
  Call QuickSort(PrnNames)
  For Index = 0 To UBound(PrnNames)
    Me.dPrinter.AddItem PrnNames(Index)
  Next
End Sub

تحياتي .

[أبو هادي]

السلام عليكم

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

وقد قمت بتجهيزها بناء على الموضوع السابق :

برمجة مربع التحرير والسرد لاحتواء أسماء الطابعات

وكنت أعتقد أثناء لصقها هنا أني ألصقها في الموضوع السابق كذلك ، ولكن لاحقا انتبهت للخلط ورأيت أنها أتت كما يقال رب رمية من غير رام :d

تحياتي .

[الدكتور خضر الرجبي]

السلام عليكم

أخي ابا هادي بارك الله فيك، إنه ليشرفني أن تعقب على مداخلاتي ومواضيعي، وكلما زادت المداخلات والافكار كلما ازددنا علما واعتقد هذا هو المغزي من هذا المنتدى.

مع الاحترام والتقدير