31-05-14, 04:51 PM
السلام عليكم و رحمة الله :
امل المساعده في البحث بإستخدام Combo
ملاحظة البحث و عرض النتائج ليس الاكمال التلقائي
ملاحظة الربط عن طريق الاداة Adodc
امل المساعده و الملف مرفق السلام عليكم و رحمة الله : امل المساعده في البحث بإستخدام Combo
ملاحظة البحث و عرض النتائج ليس الاكمال التلقائي
ملاحظة الربط عن طريق الاداة Adodc
امل المساعده و الملف مرفق 10-06-14, 01:36 PM
(31-05-14, 04:51 PM)allayl كتب : [ -> ]...
...البحث بإستخدام Combo
ملاحظة البحث و عرض النتائج ليس الاكمال التلقائي
...
(22-05-14, 01:56 AM)allayl كتب : [ -> ]...
المطلوب : عند كاتبة اول حرف يظهر النتائج المشابه فقط
يعني كتب حرف م يظهر لي محمد و ماجد فقط
...
.....
منقول
كود :
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long
Dim con As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rst As New ADODB.Recordset
Dim isBusy As Boolean '' متغير للحالة مشغولة أو لا
Private Sub Form_Load()
Call arabic ''تحويل لوحة المفاتيح للغة العربية
End Sub
Private Sub Combo1_Change()
' في حالة لا يوجد نص للبحث عنه
If Trim$(Combo1.Text) = "" Then
Combo1.Clear
Call SendMessage(Combo1.hwnd, &H14F, False, 0) '' غلق القائمة إن كانت مفتوحة
Exit Sub
End If
'-------------------------------
If isBusy Then Exit Sub '' أخرج من هنا إذا كانت الحالة مشغولة
isBusy = True '' الحالة مشغولة
'-------------------------------
Dim txt As String
txt = Combo1.Text '' الإحتفاظ بالنص المدخل
'-------------------------------
' تجهيز إعداد الإتصال
con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=db1.mdb;"
con.CursorLocation = adUseClient
'-------------------------------
con.Open ' فتح الإتصال
'-------------------------------
' تنفيذ الاستعلام
rst.Open "Select Distinct * From [allayl] WHERE [name] LIKE '" & Trim(Combo1.Text) & "%' ", con, adOpenStatic, adLockOptimistic
Combo1.Clear '' مسح محتوى الكومبو استعدادا لملئه بالجديد
Do Until rst.EOF '' إعمل حلقة تكرار طالما لم تنتهي الأسطر
Combo1.AddItem rst.Fields("name").Value
rst.MoveNext '' تحرك للتالي
Loop
'-------------------------------
con.Close ' غلق الإتصال
'-------------------------------
Call SendMessage(Combo1.hwnd, &H14F, True, 0) '' فتح القائمة لعرض النتائج
'-------------------------------
Combo1.Text = txt '' إعادة النص المدخل
Combo1.SelStart = Len(Combo1.Text) '' ضبط موقع المؤشر
'-------------------------------
isBusy = False '' الحالة غير مشغولة
'-------------------------------
End Sub
Public Sub arabic() '' تحويل لوحة المفاتيح للغة العربية
Call LoadKeyboardLayout("00000401", 1)
End Sub
Public Sub english() '' تحويل لوحة المفاتيح للغة الإنجليزية
Call LoadKeyboardLayout("00000409", 1)
End Sub.....
14-06-14, 01:23 AM
شكرآ لك