طلب مساعده في برنامج اقساط

[وليد ذكي]

السلام عليكم 

بعد اذن حضراتكم ان امكن المساعده بالمطلوب الموجود بالملف  موضح بالتفصيل

وشكرا لكم مقدما

عقود22.xlsm

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

جرب هذا الكود

Option Explicit

Private Sub Worksheet_Activate()
 data_val1
End Sub
'==================================
Private Sub ComboBox2_Change()
 ComboBox1.Clear
 Dim I%
 I = 4
 With Sheets("العقود")
 Do Until .Cells(I, "c") = vbNullString
  If .Cells(I, "c") = ComboBox2.Value Then
   ComboBox1.AddItem .Cells(I, "d")
  End If
  I = I + 1
 Loop
  End With
  
End Sub
'====================================
Sub data_val1()
Dim I%: I = 4
Dim arr
Dim rg As Object

Set rg = CreateObject("system.collections.arraylist")

With rg
 Do Until Sheets("العقود").Range("c" & I) = vbNullString
  If Not .contains(Sheets("العقود").Range("c" & I).Value) Then .Add Sheets("العقود").Range("c" & I).Value
 I = I + 1
 Loop
 .Sort
 arr = .toarray
End With

  Sheets("كشف عميل").OLEObjects("Combobox2").Object.List = Application.Transpose(arr)

End Sub

الملف مرفق

 

AouKoud_22.xlsm

[وليد ذكي]

 بارك الله فيك استاذ الغالي سليم وزادك الله من علمه دا المطلوب بالظبط شكرا لك