dynamic combobox vba excel

[mahmoud nasr alhasany]

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

 

عندى فورم مبيعات يوجد بها

كود مندوب ComboBox1 وربطه بأسم المندوب ComboBox2

(E:F)

كود مخزن ComboBox3 وربطه بأسم المخزن ComboBox4

(AE:AF)

كود موزع ComboBox5 وربطة بأسم الادارة ComboBox11

(AH:AI)

كود عميل ComboBox9 وربطة بأسم العميل  ComboBox8

(AB:AA)

كود الصنف ComboBox12 وربطة بأسم الصنف ComboBox13

(N:O)

اولا رجاء عند اختيار اى من كود المدرج اعلاه يأتى بالاسماء الخاصة بكل كود

ثانيا اريد عند اختيار كود الصنف مع ارتباطه بسعر المنتج ComboBox10

 خاص بالتسعير المنتج يظهر سعر المنتج فى TextBox7

(Q:U)

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

 

بيانات فاتورة.xlsm

تم تعديل يونيو 24 بواسطه mahmoud nasr alhasany

[محمد هشام.]

اخي بما انك تريد انشاء قاعدة بيانات لتعبئة عناصر اليوزرفورم بشكل ديناميكي ومترابط  اسهل طريقة بالنسبة لك هي انشاء جدول على ورقة  Compte magasin

يتضمن جميع الاعمدة المرغوب الاشتغال عليها مع حدف جميع الاعمدة الفارغة وتسميته مثلا ب Table1 واستبدال الاكواد الموجودة على النمودج لديك بالكود التالي 

شكل الملف بعد التعديل 

 

 '24/06/2024     by:MOHAMEED HICHAM    www.officena.net     "منتدى الاكسيل" '
Dim a, i As Long
Dim d As Object, ComboAry As Variant
Private Const Cpt As String = "Compte magasin"
Private Const tbl As String = "Table1"
Private Sub UserForm_Initialize()
a = Sheets(Cpt).ListObjects("Table1").DataBodyRange.Columns("A:X")
    Set d = CreateObject("scripting.dictionary")
    d.CompareMode = vbTextCompare
    ComboAry = Array("ComboBox1", "ComboBox3", "ComboBox5", "ComboBox9", "ComboBox12")
     For i = 0 To UBound(ComboAry): Me.Controls(ComboAry(i)).value = "*": Next i
End Sub
Private Sub ComboBox1_DropButtonClick()
Dim i As Long
    d.RemoveAll
    For i = LBound(a) To UBound(a)
          d(a(i, 2)) = "*"
    Next
       ComboBox1.List = d.keys
End Sub

Private Sub ComboBox2_DropButtonClick()
Dim i As Long
    d.RemoveAll
    For i = LBound(a) To UBound(a)
    If UCase(a(i, 2)) = UCase(ComboBox1.value) Then d(a(i, 3)) = "*"
    Next
       ComboBox2.List = d.keys
End Sub

Private Sub ComboBox3_DropButtonClick()
Dim i As Long
    d.RemoveAll
    For i = LBound(a) To UBound(a)
          d(a(i, 21)) = "*"
    Next
       ComboBox3.List = d.keys
End Sub

Private Sub ComboBox4_DropButtonClick()
Dim i As Long
    d.RemoveAll
    For i = LBound(a) To UBound(a)
    If UCase(a(i, 21)) = UCase(ComboBox3.value) Then d(a(i, 22)) = "*"
    Next
       ComboBox4.List = d.keys
End Sub

Private Sub ComboBox5_DropButtonClick()
Dim i As Long
    d.RemoveAll
    For i = LBound(a) To UBound(a)
          d(a(i, 23)) = "*"
    Next
       ComboBox5.List = d.keys
End Sub
Private Sub ComboBox11_DropButtonClick()
Dim i As Long
    d.RemoveAll
    For i = LBound(a) To UBound(a)
    If UCase(a(i, 23)) = UCase(ComboBox5.value) Then d(a(i, 24)) = "*"
    Next
       ComboBox11.List = d.keys
End Sub

Private Sub ComboBox9_DropButtonClick()
Dim i As Long
    d.RemoveAll
    For i = LBound(a) To UBound(a)
          d(a(i, 19)) = "*"
    Next
       ComboBox9.List = d.keys
End Sub
Private Sub ComboBox8_DropButtonClick()
Dim i As Long
    d.RemoveAll
    For i = LBound(a) To UBound(a)
    If UCase(a(i, 19)) = UCase(ComboBox9.value) Then d(a(i, 18)) = "*"
    Next
       ComboBox8.List = d.keys
End Sub

Private Sub ComboBox12_DropButtonClick()
Dim i As Long
    d.RemoveAll
    For i = LBound(a) To UBound(a)
          d(a(i, 4)) = "*"
    Next
       ComboBox12.List = d.keys
End Sub

Private Sub ComboBox13_DropButtonClick()
Dim i As Long
    d.RemoveAll
    For i = LBound(a) To UBound(a)
    If UCase(a(i, 4)) = UCase(ComboBox12.value) Then d(a(i, 5)) = "*"
    Next
       ComboBox13.List = d.keys
End Sub
'*************************
Private Sub ComboBox1_Change()
       ComboBox2.value = "*"
End Sub
Private Sub ComboBox3_Change()
       ComboBox4.value = "*"
End Sub
Private Sub ComboBox5_Change()
       ComboBox11.value = "*"
End Sub
Private Sub ComboBox9_Change()
       ComboBox8.value = "*"
End Sub
Private Sub ComboBox12_Change()
       ComboBox13.value = "*"
End Sub

 

[mahmoud nasr alhasany]

شكرا استاذنا محمد هشام 

على المجهود الرائع لقد  استفدت منك كثيرا 

بالنسبه للسؤال الثاني 

وهو ربط كود السعر بكود الصنف واظهار السعر في تكس بوكس ٧ مع العلم كود السعر في كومبو بوكس 10 كما موضح فى 

Compte magasin

(j:n)

تم تعديل يونيو 24 بواسطه mahmoud nasr alhasany

[محمد هشام.]

ادن يجب الحصول على ترابط 3 عناصر  combobox

10 / 12 / 13 

'**** **** A New Addition ************
Private Sub ComboBox10_DropButtonClick()
Dim i As Long
    d.RemoveAll
    For i = LBound(a) To UBound(a)
        If UCase(a(i, 4)) = UCase(ComboBox12.value) And _
                    UCase(a(i, 5)) = UCase(ComboBox13.value) Then
                    ' قائمة عمود السعر
            d(a(i, 10)) = "*": ComboBox10.List = d.keys
            'جلب قيمة عمود سعر التجزئة
             Me.TextBox7.value = a(i, 14)
        End If
    Next
End Sub
'**** Replacing ********
Private Sub ComboBox12_Change()
       ComboBox13.value = "*"
       ComboBox10.value = "*"
       Me.TextBox7.value = "*"
End Sub
"===Just a possibility===========
'لجلب السعر
'If Me.ComboBox10.value <> "*" Then _
'Me.TextBox7.value = Me.ComboBox10.value
End Sub

اليك الملف بعد اظافة الاكواد

 

بيانات فاتورة2.xlsm

[mahmoud nasr alhasany]

الف شكر استاذنا محمد هشام 

عزرا أننى لم اقم بتوضيح السؤال الثانى جيدا

أما بخصوص Combobox 10

فهو خاص بقائمة الاسعار كسبيل المثال

القائمة الافقى وهى

السعر

سعر الشراء

سعر البيع

سعر كبار عملاء

سعر التجزئه

تكون بياناتها فى Combobox 10

وعند اختيار كل بيان من Combobox 10 بما ذكرته بما يقابلها من سعر على حسب كود الصنف

مثال 

Combobox 10 اختيار سعر الشراء من القائمة

ثم كود الصنف وهو 101 

السعر بمايقابلها فى Textbox7

105

وهكذا فى مع باقى البيانات مثل كبار عملاء . جمله .تجزئه

تم تعديل يونيو 25 بواسطه mahmoud nasr alhasany

[mahmoud nasr alhasany]

هذا هو الملف نوع السعر على حسب كود الصنف

بيانات فاتورة2.xlsm

[محمد هشام.]

ماذا تقصد هل قمت بحل المشكلة بخصوص الطلب الثاني !!

 

[mahmoud nasr alhasany]

لا ابدا كان فى خطاء فى بعض الكومبوبك بخصوص الملف الاول وقمت بتعديله

وهذا بالنسبة لكود الصنف ليست هى الخليه المقصوده فقمت بتعديله

وارجو أن تساعدونى بخصوص الطلب الثانى أكرمكم الله ا/ محمد هشام

[محمد هشام.]

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

Option Compare Text
Dim a, i As Long
Dim OneRng(), Rng, rCrit1, rCrit2
Dim d As Object, ComboAry As Variant
Private Const Cpt As String = "Compte magasin"
Private Const tbl As String = "Table1"
Dim Crit(), headers(), choix(), colClé, Cnt, Item_Code
Private Sub UserForm_Initialize()
Dim Irow&
Set f = Sheets(Cpt)
a = Sheets(Cpt).ListObjects("Table1").DataBodyRange.Columns("A:X")
Set d = CreateObject("scripting.dictionary")
    d.CompareMode = vbTextCompare
   Irow = f.Columns("I:N").Find(What:="*", SearchDirection:=xlPrevious, _
                                              SearchOrder:=xlByRows).Row
                                              
 Set Cnt = f.Range("G2:N" & Irow): Crit = Cnt.value
 headers = Application.Index(Cnt.Offset(-1).value, 1)
  Me.ComboBox10.List = Application.Transpose(f.Range("J1:N1").value)
   ComboAry = Array("ComboBox1", "ComboBox3", "ComboBox5", _
                  "ComboBox9", "ComboBox10", "ComboBox13", "ComboBox12")
   For i = 0 To UBound(ComboAry): Me.Controls(ComboAry(i)).value = "*": Next i

'''''''' Code.....
 '''''''''''''''''''''

End Sub
********************************************************************
Private Sub ComboBox10_Change()
Item_Code = Val(Me.ComboBox12): Prices = Me.ComboBox10
  If IsNumeric(Me.ComboBox10) Then _
       tmp = Val(Me.ComboBox10) Else tmp = Prices
  colClé = Application.Match(tmp, headers, 0)
  For i = LBound(Crit) To UBound(Crit)
    If UCase(Crit(i, 1)) = UCase(Item_Code) And _
  Prices <> "*" Then Me.TextBox7.value = Crit(i, colClé)
  Next i
 End Sub

 

بيانات فاتورة 3.xlsm

[mahmoud nasr alhasany]

احسنت ا/محمد هشام هذا هو المطلوب 

بارك الله فيك