اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

شوقي ربيع

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

 مشاركة

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

شوقي ربيع

شوقي ربيع

قام بنشر
قام بنشر

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

  السلام عليكم

              

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

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

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

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

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

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

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

 

صورة توضيحية

 

exm1.png

 

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

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

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

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

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

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

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

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

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

 

texte prédictive 2007 2003.rar

  • Like 8
  • Thanks 1
رابط هذا التعليق
شارك
ياسر خليل أبو البراء

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

قام بنشر
قام بنشر

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

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

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

رابط هذا التعليق
شارك
شوقي ربيع

شوقي ربيع

قام بنشر
  • الكاتب
قام بنشر

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

هل هناك مكتبات 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
رابط هذا التعليق
شارك
الصـقر

الصـقر

قام بنشر
قام بنشر

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

شوقى ربيع

بارك الله فيك

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

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

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

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

تقبل تحياتى

  • Like 1
رابط هذا التعليق
شارك
شوقي ربيع

شوقي ربيع

قام بنشر
  • الكاتب
قام بنشر

 

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

شوقى ربيع

بارك الله فيك

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

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

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

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

تقبل تحياتى

 

 

 

اخى شوقى

بالفعل

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

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

ولا اليوزر

تقبل تحياتى

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

  • Like 1
رابط هذا التعليق
شارك
الصـقر

الصـقر

قام بنشر
قام بنشر

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

شوقى ربيع

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

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

 

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

 

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

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

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

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

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

مرفق ملف 

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

  • Like 1
رابط هذا التعليق
شارك
ياسر خليل أبو البراء

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

قام بنشر
قام بنشر

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

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

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

 

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

  • Like 1
رابط هذا التعليق
شارك
KHMB

KHMB

قام بنشر
قام بنشر (معدل)

 

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

شوقى ربيع

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

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

 

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

 

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

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

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

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

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

مرفق ملف 

 

 

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

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

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

تم تعديل بواسطه KHMB
  • Like 1
رابط هذا التعليق
شارك
شوقي ربيع

شوقي ربيع

قام بنشر
  • الكاتب
قام بنشر

السلام عليكم

اخوتي في الله

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

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

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

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

رابط هذا التعليق
شارك
ابو فارس2013

ابو فارس2013

قام بنشر
قام بنشر

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

هل هناك مكتبات 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

السلام عليكم

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

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

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

وشكرا

رابط هذا التعليق
شارك
الصـقر

الصـقر

قام بنشر
قام بنشر

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

شوقى ربيع

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

Me.ComboBox1.List = b.keys

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

تقبل تحياتى

رابط هذا التعليق
شارك
زائر
هذا الموضوع مغلق.
 مشاركة
الذهاب الي قائمه المواضيع

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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept