قائمة منسدله ( مع تصفيه ) !

[ابو اياد ( الاسيوطى )]

انت رائع استاذى // بن عليه

ولك ترفع القبعات

حقيقه توصلت لنصف هذا ولم اصل الى ما وصلت حضرتك له بارك الله فيكم

قمت بتغيير معادله داتا فلاداشن ولكن توقفت بعدها ولم يكن فى مخيلتى تغير اسماء النطاقات بهذه المعادلات 

تقبل تحياتى

 

تعلمت منكم الكثير ايها الرائعون نابغه المعادلات ( بن عليه حاجى )

[عبد الرحمن الحمصي]

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

أحبائي في الله شكرا لجهودكم

 

أخي محمد الأسيوطي

 

نريد دعمك لحل مشكلة نقل الكود من مصنف إلى آخر

فقد قمت بنقله تماما كما هو وسميت أوراق المصنف كما هي في المصنف الأصلي ومازال لا يعمل

هل يوجد شيء معين داخل الكود يجب تعديله

 

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

أخي الكريم عبد الرحمن، شيء واحد لم أتناوله في شرحي السابق في الملف فيها يخص الأكواد وهو مهم، أولا اسم الشيت الوحيد الذي يجب أن يكون موجودا في ملفك الجديد هو شيت "LISTS" المشار إليه في الأكواد الخاصة بالكومبوبوكس الموضوعة في كود حدث الشيت DataEntry وثانيا (وهو الأهم) لا يجب نقل أكواد شيت DataEntry إلا بعد إدراج القوائم المنسدلة في هذا الشيت باستعمال خاصية Data Validation والتسميات الخاصة بهذه القوائم ثم وضع الأكواد في كود حدث الشيت DataEntry (أو غيره -في أي شيت يحوي قوائم منسدلة-)... والله أعلم

 

أرجو أني وصلت إلى تقريب المفهوم...

 

أخوك بن علية

أخوتي الأفاضل شكرا لكم و لجهودكم 

أخي بن عليه سوف أقوم بتطبيق ما أشرت إليه و أعود إليك بالنتائج

 

لك كل الود و التقدير

[عبد الرحمن الحمصي]

نفس المشكلة أعذرني أخي بن عليه 

 

أرفقت لك المصنف الجديد وصورة اشارة الخطأ

 

عسى أن يلهمك الله خيرا

Test.rar

[عبد الرحمن الحمصي]

up pls

[بن علية حاجي]

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

نفس المشكلة أعذرني أخي بن عليه 

 

أرفقت لك المصنف الجديد وصورة اشارة الخطأ

 

عسى أن يلهمك الله خيرا

أخي الكريم عبد الرحمن، معذرة على عدم التعمق أكثر في شرح العملية، وأقدم لك كيفية تصحيح الأخطاء في الكود مع كيفية إدراج الكومبوبوكس الخاص بالقوائم المنسدلة...

أولا : عملية تصحيح الخطأ الذي أوردته في ردك السابق ويتعلق الأمر بعدم وجود مكتبة Microsoft Forms 2.0 Object Library في VBA وكيفية إضافتها تكون كما يلي (وقد شرحت ذلك أيضا في الملف التنفيذي المرفق بالأسفل):

- فتح VBA

- فتح خاصية Tools (أو Outils) ثم References

- نختار المكتبة المعنية في القائمة إن وُجدت، وإن لم تكن موجودة نبحث عنها في الجهاز بالدليل C:\windows\system32 وملف المكتبة هو FM20.DLL ويمكن تحميله من الرابط التالي (إن لم يكن موجودا في الجهاز) :

 

ملف المكتبة : FM20.rar

 

ثانيا : إدراج الكومبوبوكس الخاص بالقوائم المنسدلة

يمكن اتباع ما جاء في الملف المرفق التالي بصيغة pdf (أرجو أن تكون مراحل الإنشاء مفهومة ويمكن أيضا اتباع الخطوات بالملف التنفيذي المرفق بالأسفل) :

 

ملف pdf الخاص بالكومبوبوكس :  Add the Combo box.rar

 

أرجو أن يكون هذا الشرح مفهوما ومستوفيا المطلوب... وفي الملف المرفق التالي (ملف تنفيذي) شرح لكل المراحل السابقة تم تطبيقه على ملفك TEST.xlsm المرفق في ردك السابق (وقد أرفقته بالتصحيحات بالأسفل): 

 

الملف التنفيذي : hb2.rar

 

الملف test.xlsm المصحح : تجربة.rar

 

 

أخوك بن علية

[عبد الرحمن الحمصي]

أخي بن عليه حاجي و الله أن لقب خبير اكسل قليل عليك

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

شكرا جزيلا على هذا الشرح الكافي و الوافي و الشافي , تم النقل الكود بنجاح الحمد لله

 

أخي بن عليه 

هل يمكن لنا أن نخفي الفراغات في آخر القائمة المنسدلة ( مع العلم أني اريد اضافة اسماء جديدة لاحقا في نفس العمود و اريدها ان تضاف تلقائيا إلى القائمة المنسدلة )

لدي هذه المعادلة ولكنها لم تنجح لا اعرف ما السبب :

 

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

ولك كل التحية يا مبدع

 

 

تجربة بعد التعديل.rar

[بن علية حاجي]

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

 

أخي الكريم عبد الرحمن، تم عمل المطلوب بالمعادلة نفسها (استعمال الدالة OFFSET)....

 

 

أخوك بن علية

 

 

المرفق : تجربة بعد التعديل.rar

[أبو محمد عباس]

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

الاستاذ والاخ الحبيب بن علية حاجي جزاك الله خيرا

جهد كبير وعمل رائع جعله الله في ميزان حسناتك

وفقك الله وزادك من فضله علما وشرفا

تقبل فائق احترامي وتقديري

[عبد الرحمن الحمصي]

اخي بن عليه سلمت يداك يا مبدع

[حمادة باشا]

الأستاذ الفاضل/ بن علية حاجي

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

مبدع دائما كالعادة - ومعلومات قيمة وإفادة

جزاكم الله كل خير

[اسلام سيد]

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

 

هل من الممكن زيادة المطلوب والتطبيق على الشيت المرفق

 

المطلوب :

فلترت هذة القائمه المنسدلة

 

بشرطين :
1-اسم العميل معتمد على اسم المكتب (وهذا الشرط محقق بالفعل من خلال المعادله التاليه)

OFFSET(Sheet1!B2;MATCH(A4;Sheet1!A2:A948;0)-1;;COUNTIF(Sheet1!A2:A948;A4))
 

2-عند كتابة حرف الفلترا وليكن   (س)   يظهر كل اسم به حر ف (س)  سواء كانت (س) فى   اول الاسم او المنتصف او الاخر

 

*-جزاكم الله خير نفعنا بكم

 

ملفات مرفقه

 

فلترت قائمه منسدله بشرطين.rar

تم تعديل فبراير 22, 2014 بواسطه إسلام الشيمي

[عبد الرحمن الحمصي]

أخي بن عليه لدي تسائل صغير اذا كان ذلك ممكنا

 

هل يمكن أن يتم تفعيل الكومبو بوكس ب ( double click ) اي بعد ضغطتين بالماوس بدلا من ضغطة واحدة و ذلك لتجنب التعديل الغير متعمد

 

اليك الكود مرة أخرى

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim ws As Worksheet
Dim str As String
Dim i As Integer
Dim rngDV As Range
Dim rng As Range
Dim strMsg As String
Dim lRsp As Long
strMsg = "Add this item to the list?"

If Target.Count > 1 Then Exit Sub
Set ws = Worksheets("Data Entry")
  
If Target.Row > 1 Then
  On Error Resume Next
  Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
  On Error GoTo 0
  If rngDV Is Nothing Then Exit Sub
  
  If Intersect(Target, rngDV) Is Nothing Then Exit Sub
  If Target = "" Then Exit Sub
    
  str = Target.Validation.Formula1
  str = Right(str, Len(str) - 1)
  On Error Resume Next
  Set rng = ws.Range(str)
  On Error GoTo 0
  If rng Is Nothing Then Exit Sub
  
  If Application.WorksheetFunction _
    .CountIf(rng, Target.Value) Then
    Exit Sub
  Else
   lRsp = MsgBox(strMsg, vbQuestion + vbYesNo, "Add New Item?")
   If lRsp = vbYes Then
    i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1
    ws.Cells(i, rng.Column).Value = Target.Value
    rng.Sort Key1:=ws.Cells(1, rng.Column), _
      Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom
    End If
  End If

End If

End Sub

' Developed by Contextures Inc.
' www.contextures.com
Private Sub TempCombo_KeyDown(ByVal _
        KeyCode As MSForms.ReturnInteger, _
        ByVal Shift As Integer)
        
On Error Resume Next
Dim ws As Worksheet
Dim str As String
Dim i As Integer
Dim rngDV As Range
Dim rng As Range
Dim strMsg As String
Dim lRsp As Long
Dim c As Range
strMsg = "Add this item to the list?"

Set ws = Worksheets("Data Entry")
Set c = ActiveCell
    
  str = c.Validation.Formula1
  str = Right(str, Len(str) - 1)
  On Error Resume Next
  Set rng = ws.Range(str)
  On Error GoTo 0
  If rng Is Nothing Then Exit Sub
        
    'Hide combo box and move to next cell on Enter and Tab
    Select Case KeyCode
        Case 9
            c.Offset(0, 1).Activate
              If c.Value = "" Then Exit Sub

              If Application.WorksheetFunction _
                  .CountIf(rng, c.Value) Then
                  Exit Sub
                Else
                 lRsp = MsgBox(strMsg, vbQuestion + vbYesNo, "Add New Item?")
                 If lRsp = vbYes Then
                  i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1
                  ws.Cells(i, rng.Column).Value = c.Value
                  rng.Sort Key1:=ws.Cells(1, rng.Column), _
                    Order1:=xlAscending, Header:=xlYes, _
                    OrderCustom:=1, MatchCase:=False, _
                    Orientation:=xlTopToBottom
                  End If
                End If

        Case 13
            c.Offset(1, 0).Activate
              If c.Value = "" Then Exit Sub
              If Application.WorksheetFunction _
                  .CountIf(rng, c.Value) Then
                  Exit Sub
                Else
                 lRsp = MsgBox(strMsg, vbQuestion + vbYesNo, "Add New Item?")
                 If lRsp = vbYes Then
                  i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1
                  ws.Cells(i, rng.Column).Value = c.Value
                  rng.Sort Key1:=ws.Cells(1, rng.Column), _
                    Order1:=xlAscending, Header:=xlYes, _
                    OrderCustom:=1, MatchCase:=False, _
                    Orientation:=xlTopToBottom
                  End If
                End If
        Case Else
            'do nothing
    End Select

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet
Dim rng As Range
Dim i As Integer
Dim strMsg As String
Dim lRsp As Long
Set ws = ActiveSheet
Set wsList = Sheets("Data Entry")
Set cboTemp = ws.OLEObjects("TempCombo")
strMsg = "Add this item to the list?"

If Target.Count > 1 Then GoTo exitHandler

  On Error Resume Next
  With cboTemp
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
  End With
On Error GoTo errHandler
  If Target.Validation.Type = 3 Then
    Application.EnableEvents = False
    str = Target.Validation.Formula1
    str = Right(str, Len(str) - 1)
    With cboTemp
      .Visible = True
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 15
      .Height = Target.Height + 3
      .ListFillRange = str
      .LinkedCell = Target.Address
    End With
    
    cboTemp.Activate
  End If
  
exitHandler:
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Exit Sub
errHandler:
  Resume exitHandler

End Sub

سامحنا على الإزعاج 

شكرا جزيلا

[بن علية حاجي]

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

أخي بن عليه لدي تسائل صغير اذا كان ذلك ممكنا

 

هل يمكن أن يتم تفعيل الكومبو بوكس ب ( double click ) اي بعد ضغطتين بالماوس بدلا من ضغطة واحدة و ذلك لتجنب التعديل الغير متعمد

 

اليك الكود مرة أخرى

 

سامحنا على الإزعاج 

شكرا جزيلا

أخي الكريم عبد الرحمن، يمكن ذلك جدا بتبديل كود SelectionChange بـكود  BeforeDoubleClick ولكن ما تريده "تجنب التعديل غير المتعمد" غير ممكن باعتبار أن القوائم المنسدلة (العادية) تبقى ظاهرة بمجرد تحديد الخلايا التي تحويها والكومبو يبقى أيضا ظاهرا في الخلية التي تحوي القائمة المنسدلة بمجرد النقر عليها نقرا مزدوجا (ولا يلغى ظهور الكومبو إلا بالنقر المزدوج على خلية أخرى ليس فيها قائمة منسدلة)... والله أعلم

 

بالنسبة لأخي إسلام الشيمي فهمت مطلوبك وتجدني أحاول فيه (متحفظا)...

 

أخوكم بن علية

[بن علية حاجي]

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

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

 

هل من الممكن زيادة المطلوب والتطبيق على الشيت المرفق...

 

المطلوب : فلترة هذه القائمة المنسدلة

 

بشرطين :

1- اسم العميل معتمد على اسم المكتب (وهذا الشرط محقق بالفعل من خلال المعادلة التالية) -------> تم تعديلها

 

2- عند كتابة حرف الفلترة وليكن (س) يظهر كل اسم به حرف (س) سواء كانت (س) في أول الاسم ------> تم تحقيق هذا الشرط في المرفق (بعد ترتيب القائمة الكلية ترتيبا تصاعديا حسب اسم المكتب وحسب اسم العملاء)..... أو المنتصف أو الآخر ---------> لم أتمكن من ذلك (بالمعادلات لسبب شرط ترتيب القائمة الكلية).... ومعذرة لذلك. 

 

جازاكم الله خيرا ونفعنا بكم

أخي الكريم إسلام الشيمي، كما وعدتك أني أعمل على المطلوب وقد قمت بما أستطعته على الملف... غير أني لم أتمكن من جعل الفلترة تعرض الأسماء التي تحوي الحرف المحجوز في خلايا العمود B لسبب أن ذلك غير ممكن بالمعادلات وبالطريقة التي تم بها إدراج القوائم المنسدلة المفلترة (إن كانت القائمة المنسدلة في خلية واحدة فذلك ممكن بتعديلات أخرى على المعادلات وإضافة أعمدة مساعدة ولكن في الملف القائمة المفلترة تم نسخها إلى الأسفل في العمود B).... يمكن أن تحجز أكثر من حرف واحد في الخلية الواحدة.... 

 

أخوك بن علية

 

المرفق : فلترت قائمه منسدله بشرطين.rar

[اسلام سيد]

السلام عليكم

جزاكم الله خيرا استاذى ابن علية حاجى

 

 

 

(إن كانت القائمة المنسدلة في خلية واحدة فذلك ممكن بتعديلات أخرى على المعادلات وإضافة أعمدة مساعدة

 

 

هل حضرتك تقصد أن تكون القائمة غير مرتبطه بقائمه اخرى كاسم المكتب والعميل

 

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

 

جزاكم الله خيرا

 

ملفات مرفقه

فلترالقائمة المنسدله111.rar

[بن علية حاجي]

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

 

أخي الكريم إسلام، جرب المرفق بالأسفل وأعرف أنه ما زالت بعض التعديلات (وعلى الخصوص الحالة التي نختار فيها خلية تحوي قبلا بعض الحروف -في حالتنا يجب مسحها وإعادة كتابتها من جديد)...

 

أخوك بن علية

 

ملاحظات :

- عند كتابة بعض الحروف من اسم العميل يجب التأكيد بزر ENTER ثم الاختيار من القائمة المنسدلة في الخلية.

- لا  يمكن اختيار عدة قيم للفلترة مثل : حم / سل / ب (كل مرة اختيار واحد).

- القوائم المنسدلة تعمل بالشرطين (اسم المكتب واسم العميل)...

 

المرفق : فلترالقائمة المنسدله112.rar

[عبد الرحمن الحمصي]

أخي بن عليه ما شاء الله عليك يا مبدع

[اسلام سيد]

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

 

أخي الكريم إسلام، جرب المرفق بالأسفل وأعرف أنه ما زالت بعض التعديلات (وعلى الخصوص الحالة التي نختار فيها خلية تحوي قبلا بعض الحروف -في حالتنا يجب مسحها وإعادة كتابتها من جديد)...

 

أخوك بن علية

 

ملاحظات :

- عند كتابة بعض الحروف من اسم العميل يجب التأكيد بزر ENTER ثم الاختيار من القائمة المنسدلة في الخلية.

- لا  يمكن اختيار عدة قيم للفلترة مثل : حم / سل / ب (كل مرة اختيار واحد).

- القوائم المنسدلة تعمل بالشرطين (اسم المكتب واسم العميل)...

 

المرفق : فلترالقائمة المنسدله112.rar

 

جزاكم الله خيرا

 

اعلم ان الموضوع يحتاج الى تطوير فى المستقبل لكن على اى حال تسلم ايدك