النص التنبئي على الكمبوبوكس (حركة مميزة)

**شوقي ربيع** · مارس 3, 2015

بسم الله الرحمان الرحيم

السلام عليكم

اولا ما هو النص التنبئي

باختصار هو تنبئ البرنامج او الدالة او الكود بالكلمات التي تبحث عنها من خلال كتابة اول حروف الكلمة مثل مايحدث اثناء البحث عن طريق محرك البحث قوقل

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

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

ما هي الفائدة من هذا الموضوع

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

لا اطيل عليكم في المرفق تجد مثال توضيحي احدهما مطبق على الشيت وهو مايهم اصحاب ادخالات الفواتير والثاني مطبق على الفورم

صورة توضيحية

بالنسبة للمثال المطبق على الشيت كما في الصورة من جهة اليمين

عند الضغط على اي خلية ملونة بالاخضر تظهر كمبوبكس اكتب داخلها اي حرف لتجلب لك الكلمات التي تحمل تلك الحرف كما في الصورة

يمكنك التنقل بين النتائج بواسطة سهم الاعلى والاسفل من الكبيور

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

بالنسبة للمثال المطبق على الفورم كما في الصورة من جهة اليسار

نفس الامر كما في المثال الاول فقط الاختلاف في ان ادالبحث يكون من الفورم

ارجو ان يكون الموضوع مفيد للجميع

تحياتي للجميع

تنويه تم استبدال المرفق بعد 23 تحميل

texte prédictive 2007 2003.rar

**محمد الورفلي1** · مارس 3, 2015

السلام عليكم استاذ شوقي ربيع

فكرة جميلة

ممكن على 2003

**شوقي ربيع** · مارس 3, 2015

السلام عليكم استاذ شوقي ربيع

فكرة جميلة

ممكن على 2003

تم اضافة ملف 2003 في الموضوع الاصلي

ياسر خليل أبو البراء · مارس 3, 2015

بارك الله فيك أخي الحبيب شوقي ....

أتعجب لعدم عمل الملف معي .. لا يتم تفعيل الكومبوبوكس !!!!!!!!

**شوقي ربيع** · مارس 3, 2015

بارك الله فيك أخي الحبيب شوقي ....

أتعجب لعدم عمل الملف معي .. لا يتم تفعيل الكومبوبوكس !!!!!!!!

جرب الملف الثاني 2003

ياسر خليل أبو البراء · مارس 3, 2015

بالفعل جربته ولم يعمل أيضاً ..

هل هناك مكتبات References يجب إضافتها ؟؟

في انتظار تجربة الملف من قبل الأعضاء

خزاني · مارس 3, 2015

بارك الله فيك أخي شوقي

**شوقي ربيع** · مارس 3, 2015

بالفعل جربته ولم يعمل أيضاً ..

هل هناك مكتبات References يجب إضافتها ؟؟

في انتظار تجربة الملف من قبل الأعضاء

عجبا

لا يوجد اي مكتابات References تضاف

هذا هو الكود الخاص بالمثال الاول

Option Explicit
Dim a()
Dim b, c, d, e
Dim ws As Worksheet
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Set ws = Sheets("data")
  If Not Intersect([A2:A17], Target) Is Nothing And Target.Count = 1 Then
  e = ws.Cells(Rows.Count, 1).End(xlUp).Row
  a = ws.Range("A2:A" & e).Value
  With Me.ComboBox1
         .List = a
         .Height = Target.Height + 3
         .Width = Target.Width
         .Top = Target.Top
         .Left = Target.Left
         .Visible = True
         .Activate
         .ListRows = 20
         .MatchEntry = fmMatchEntryNone
         .TextAlign = fmTextAlignRight
  End With
    Me.ComboBox1 = Target
  Else
    Me.ComboBox1.Visible = False
  End If
If Not Intersect([H2:H17], Target) Is Nothing And Target.Count = 1 Then
  UserForm1.Left = Target.Left + 150
  UserForm1.Top = Target.Top + 70 - Cells(ActiveWindow.ScrollRow, 1).Top
  UserForm1.Show
End If
End Sub

Private Sub ComboBox1_Change()
 If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then
   Set b = CreateObject("Scripting.Dictionary")
   d = UCase(Me.ComboBox1) & "*"
   For Each c In a
     If UCase(c) Like d Then b(c) = ""
   Next c
   Me.ComboBox1.List = b.keys
   Me.ComboBox1.DropDown
 End If
   ActiveCell.Value = Me.ComboBox1
End Sub
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  e = ws.Cells(Rows.Count, 1).End(xlUp).Row
  Me.ComboBox1.List = ws.Range("A2:A" & e).Value
  Me.ComboBox1.Activate
  Me.ComboBox1.DropDown
End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   If KeyCode = 13 Then ActiveCell.Offset(1).Select
End Sub

وهذا خاص بالمثال الثاتي اي اليوزرفورم

Option Explicit

Dim a()
Dim b, c, d, e

Private Sub Label1_Click()
  ActiveCell = Me.ComboBox1
  Unload Me
End Sub

Private Sub UserForm_Initialize()
Me.Caption = "http://www.officena.net"
Dim ws As Worksheet: Set ws = Sheets("data")
  e = ws.Cells(Rows.Count, 1).End(xlUp).Row
  a = ws.Range("A2:A" & e).Value
  With Me.ComboBox1
      .List = a
      .ListRows = 20
      .MatchEntry = fmMatchEntryNone
      .TextAlign = fmTextAlignRight
  End With
End Sub
Private Sub ComboBox1_Change()
  Set b = CreateObject("Scripting.Dictionary")
  d = UCase(Me.ComboBox1) & "*"
  For Each c In a
    If UCase(c) Like d Then b(c) = ""
  Next c
  Me.ComboBox1.List = b.keys
  Me.ComboBox1.DropDown
End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = 13 Then ActiveCell = Me.ComboBox1: Unload Me
End Sub

**الصـقر** · مارس 4, 2015

استاذى الحبيب

شوقى ربيع

بارك الله فيك

وزادك الله علما

نفس المشكله اللى حصلت مع الاستاذ ياسر حصلت معى

الملفين لا يظهر الكمبوبوكس ولا اليوزرفورم

ياريت حل المشكله مشتاق للاطلاع على العمل

تقبل تحياتى

**إبراهيم ابوليله** · مارس 4, 2015

اخى شوقى

بالفعل

عند الضغط فى الخلايا الملونه

لاتظهر الكوموبوكس

ولا اليوزر

تقبل تحياتى

**شوقي ربيع** · مارس 4, 2015

استاذى الحبيب

شوقى ربيع

بارك الله فيك

وزادك الله علما

نفس المشكله اللى حصلت مع الاستاذ ياسر حصلت معى

الملفين لا يظهر الكمبوبوكس ولا اليوزرفورم

ياريت حل المشكله مشتاق للاطلاع على العمل

تقبل تحياتى

اخى شوقى

بالفعل

عند الضغط فى الخلايا الملونه

لاتظهر الكوموبوكس

ولا اليوزر

تقبل تحياتى

تم حل المشكل و تم استبدال المرفق في المشاركة الرئيسية

**KHMB** · مارس 4, 2015

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

الاستاذ شوقي ربيع

الملفين شغاله 100%

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

**الصـقر** · مارس 4, 2015

استاذى القدير

شوقى ربيع

عمل اكثر من رائع وهذا ما تعودناه منكم

زادكم الله علما

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

يمكن استبدال هذا السطر

   d = UCase(Me.ComboBox1) & "*"

بالسطر التالى

  d = UCase("*" & (Me.ComboBox1) & "*")

للبحث عن الحرف فى اى كلمة من الخلية فى النطاق المحدد

مرفق ملف

كمبوبوكس بالبحث.zip

**إبراهيم ابوليله** · مارس 4, 2015

اخى واستاذنا شوقى

بالفعل

الملف يعمل جيدا

تقبل حياتى

ياسر خليل أبو البراء · مارس 4, 2015

أخي الغالي شوقي

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

لاحرمنا الله من إبداعاتك المنقطعة النظير

وفي انتظااااااااااااااااار المزيد من الإبداعات ..متبخلش علينا باللي عندك

**KHMB** · مارس 4, 2015

استاذى القدير

شوقى ربيع

عمل اكثر من رائع وهذا ما تعودناه منكم

زادكم الله علما

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

يمكن استبدال هذا السطر
   d = UCase(Me.ComboBox1) & "*"
بالسطر التالى
  d = UCase("*" & (Me.ComboBox1) & "*")
للبحث عن الحرف فى اى كلمة من الخلية فى النطاق المحدد

مرفق ملف

الاستاذ حسام الكود الخاص بالاستاذ شوقي ربيع هو البحث والإكمال ( يبدأ بـ )

والكود الخاص بك البحث والإكمال ( يحتوي علي ) أي سيظهر لك كل كلمة او حرف في النطاق يحتوي علي الحرف او الاسم.للعلم والإحاطة فقط

جزاكم الله عننا خير الجزاء

تم تعديل مارس 4, 2015 بواسطه KHMB

**Yasser Fathi Albanna** · مارس 4, 2015

عمل أكثر من رائع أخى الأستاذ / شوقي ربيع

تقبل تحياتى وتقديرى

جزاك الله خير

**Akram Galal** · مارس 4, 2015

أ/ شوقي

مش عارف أقولك ايه

تحفة تحفة تحفة

**ضاحي الغريب** · مارس 5, 2015

أب مارية · مارس 5, 2015

السلام عليكم

أستاذي شوقي عمل ممتاز

دائما متألق بإبداعاتك

يحفظك الله

الحدادي · مارس 5, 2015

جميل جدا

**شوقي ربيع** · مارس 5, 2015

السلام عليكم

اخوتي في الله

KHMB
الصـقـر
إبراهيم ابوليله
YasserKhalil
Eng : Yasser Fathi Albanna
أكرم جلال
ضاحي الغريب
أب مارية
الحدادي

كل باسمه مع حفظ الالقاب

لكم مني جزيل الشكر وفائق الحترام

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

ابو فارس2013 · مارس 6, 2015

بالفعل جربته ولم يعمل أيضاً ..

هل هناك مكتبات References يجب إضافتها ؟؟

في انتظار تجربة الملف من قبل الأعضاء

عجبا

لا يوجد اي مكتابات References تضاف

هذا هو الكود الخاص بالمثال الاول

Option Explicit
Dim a()
Dim b, c, d, e
Dim ws As Worksheet
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Set ws = Sheets("data")
  If Not Intersect([A2:A17], Target) Is Nothing And Target.Count = 1 Then
  e = ws.Cells(Rows.Count, 1).End(xlUp).Row
  a = ws.Range("A2:A" & e).Value
  With Me.ComboBox1
         .List = a
         .Height = Target.Height + 3
         .Width = Target.Width
         .Top = Target.Top
         .Left = Target.Left
         .Visible = True
         .Activate
         .ListRows = 20
         .MatchEntry = fmMatchEntryNone
         .TextAlign = fmTextAlignRight
  End With
    Me.ComboBox1 = Target
  Else
    Me.ComboBox1.Visible = False
  End If
If Not Intersect([H2:H17], Target) Is Nothing And Target.Count = 1 Then
  UserForm1.Left = Target.Left + 150
  UserForm1.Top = Target.Top + 70 - Cells(ActiveWindow.ScrollRow, 1).Top
  UserForm1.Show
End If
End Sub

Private Sub ComboBox1_Change()
 If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then
   Set b = CreateObject("Scripting.Dictionary")
   d = UCase(Me.ComboBox1) & "*"
   For Each c In a
     If UCase(c) Like d Then b(c) = ""
   Next c
   Me.ComboBox1.List = b.keys
   Me.ComboBox1.DropDown
 End If
   ActiveCell.Value = Me.ComboBox1
End Sub
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  e = ws.Cells(Rows.Count, 1).End(xlUp).Row
  Me.ComboBox1.List = ws.Range("A2:A" & e).Value
  Me.ComboBox1.Activate
  Me.ComboBox1.DropDown
End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   If KeyCode = 13 Then ActiveCell.Offset(1).Select
End Sub

وهذا خاص بالمثال الثاتي اي اليوزرفورم

Option Explicit

Dim a()
Dim b, c, d, e

Private Sub Label1_Click()
  ActiveCell = Me.ComboBox1
  Unload Me
End Sub

Private Sub UserForm_Initialize()
Me.Caption = "http://www.officena.net"
Dim ws As Worksheet: Set ws = Sheets("data")
  e = ws.Cells(Rows.Count, 1).End(xlUp).Row
  a = ws.Range("A2:A" & e).Value
  With Me.ComboBox1
      .List = a
      .ListRows = 20
      .MatchEntry = fmMatchEntryNone
      .TextAlign = fmTextAlignRight
  End With
End Sub
Private Sub ComboBox1_Change()
  Set b = CreateObject("Scripting.Dictionary")
  d = UCase(Me.ComboBox1) & "*"
  For Each c In a
    If UCase(c) Like d Then b(c) = ""
  Next c
  Me.ComboBox1.List = b.keys
  Me.ComboBox1.DropDown
End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = 13 Then ActiveCell = Me.ComboBox1: Unload Me
End Sub

السلام عليكم

مشكورين جميعا لماا تقدموه جعله الله في ميزان حسناتكم ان شاء الله

اريد منكم ان تشرحوا لي الكود اذا امكن او اقل شي تشرحوا لي اين الجزء الخاص بجلب البيانات من شيت الداتا

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

وشكرا

اباالياس · مارس 6, 2015

لسلام عليكم استاذ شوقي ربيع

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

تم تعديل مارس 6, 2015 بواسطه اباالياس

**الصـقر** · مارس 9, 2015

استاذى الفاضل

شوقى ربيع

هذا السطر بالكود

Me.ComboBox1.List = b.keys

أود الاستفسار عن هذه الجزئية b.keys ( انا فاهم ان b تشير الى القاموس ) فماذا تعنى keys

تقبل تحياتى

تسجيل الدخول

النص التنبئي على الكمبوبوكس (حركة مميزة)

الردود الموصى بها

شوقي ربيع

محمد الورفلي1

شوقي ربيع

ياسر خليل أبو البراء

شوقي ربيع

ياسر خليل أبو البراء

خزاني

شوقي ربيع

الصـقر

إبراهيم ابوليله

شوقي ربيع

KHMB

الصـقر

إبراهيم ابوليله

ياسر خليل أبو البراء

KHMB

Yasser Fathi Albanna

Akram Galal

ضاحي الغريب

أب مارية

الحدادي

شوقي ربيع

ابو فارس2013

اباالياس

الصـقر

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information