المطلوب تعديل Models بحث تبحث في حقل رقمي وليس فقط البحث في حقل نص

[magdidir]

السادة اعضاء المنتدى العظيم 

اسعد الله صباحكم , وجمعة مباركة عالجميع

المطلوب مساعدتي ان امكن وبعد اذنكم تعديل المودل عدد 2 موجودة في البرنامج بحيث يصبح بامكاني البحث في الحقل الرقمي ، علما بأنها تعمل بشكل ممتاز للبحث في الحقول النصية ، وبامكانها البحث في اكثر من حقل وتضييق البحث او توسيع مدى البحث في اي جدول مهما كان كبر عدد الحقول فيه، 

مرفق قاعدة البيانات 

ومشكورين سلفا

31-01-2025.rar

تم تعديل يناير 31 بواسطه magdidir

[Foksh]

وعليكم السلام ورحمة الله وبركاته أخي @magdidir ..

حاولت فهم المطلوب الذي لا يتم فعله في نموذجك ، ولكني وجدت انه عند كتابة رقم الشركة أو رقم الموظف بشكل يدوي يتم البحث عنه بكل سلاسة ..إلا إذا قمت بالتوضيح عن آلية البحث التي تقوم بها ولم تنجح معك .

 

[magdidir]

37 دقائق مضت, Foksh said:

وعليكم السلام ورحمة الله وبركاته أخي @magdidir ..

حاولت فهم المطلوب الذي لا يتم فعله في نموذجك ، ولكني وجدت انه عند كتابة رقم الشركة أو رقم الموظف بشكل يدوي يتم البحث عنه بكل سلاسة ..إلا إذا قمت بالتوضيح عن آلية البحث التي تقوم بها ولم تنجح معك .

 

بارك الله فيك اخي @Foksh

بعد ان رفعت الموضوع تيقنت اني لم اعبر بالطريقة الصحيحة عن مرادي: 

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

[kkhalifa1960]

اي مربع تضع كلمة البحث به ............. والناتج على أي هيئة فورم أم استعلام 

[magdidir]

1 دقيقه مضت, kkhalifa1960 said:

اي مربع تضع كلمة البحث به ............. والناتج على أي هيئة فورم أم استعلام 

اسعد الله صباحك اخي ? Kkhalifa1960 

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

المطلوب ان يتم البحث في الحقل الرقمي : رقم الشركة ، رقم السائق 

[magdidir]

Private Sub ÃãÑ154_Click()
 Dim MyCriteria As String
    Dim ArgCount As Integer

    ArgCount = 0

    MyCriteria = ""
    DoCmd.Hourglass True
    
    AddToWhereegal [r1], "[companNO]", MyCriteria, ArgCount
   AddToWhereegal [M], "[DrivNO]", MyCriteria, ArgCount
   'AddToWhereegal [mo], "[SenfNO]", MyCriteria, ArgCount
     'AddToWhereegal [cc], "[carno]", MyCriteria, ArgCount
     If IsNothing(MyCriteria) Then
     DoCmd.OpenForm "dd12", acNormal, acFormReadOnly
       
   Else
       DoCmd.OpenForm "dd12", acNormal, , MyCriteria
       If IsNothing(Forms![dd12].RecordsetClone.RecordCount) Then
          MsgBox "áÇ íæÌÏ ãÚáæãÇÊ ÈÇáãæÇÕÝÇÊ ÇáãÐßæÑÉ"
          DoCmd.Close acForm, "dd12"
       End If
    End If
    DoCmd.Hourglass False
End Sub
 

[kkhalifa1960]

استاذ @magdidir جرب التعديل ووافني بالرد .

31-01-2025-111.rar

[magdidir]

8 ساعات مضت, kkhalifa1960 said:

استاذ @magdidir جرب التعديل ووافني بالرد .

31-01-2025-111.rar 115.56 kB · 8 downloads

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

في قاعدة البيانات الجديدة المرفقة مع الصورة اتمنى من الله عز وجل ان اكون قد وفقت في توضيح المطلوب ، واعتذر منكم جميعا لضعفي في ايصال فكرتي 

31-01-2025- last.accdb

[Foksh]

11 ساعات مضت, Foksh said:

حاولت فهم المطلوب الذي لا يتم فعله في نموذجك ، ولكني وجدت انه عند كتابة رقم الشركة أو رقم الموظف بشكل يدوي يتم البحث عنه بكل سلاسة ..إلا إذا قمت بالتوضيح عن آلية البحث التي تقوم بها ولم تنجح معك .

بعد فهم الموضوع بشكل مناسب ، جرب تعديل المديول X1 بهذا التعديل البسيط

 

Option Compare Database
Option Explicit

Sub AddToWheredate(fieldvalue As Variant, FieldName As String, MyCriteria As String, ArgCount As Integer)
    Dim mydate As Variant
    If fieldvalue <> "" And IsDate(fieldvalue) Then
        mydate = fieldvalue
        mydate = Format(mydate, "m-d-yy")
        If ArgCount > 0 Then
            MyCriteria = MyCriteria & " and "
        End If
        MyCriteria = (MyCriteria & FieldName & " = #" & mydate & "#")
        ArgCount = ArgCount + 1
    End If
End Sub

Sub AddToWhereegal(fieldvalue As Variant, FieldName As String, MyCriteria As String, ArgCount As Integer)
    If fieldvalue <> "" Then
        If ArgCount > 0 Then
            MyCriteria = MyCriteria & " and "
        End If
        If IsNumeric(fieldvalue) Then
            MyCriteria = (MyCriteria & FieldName & " = " & fieldvalue)
        Else
            MyCriteria = (MyCriteria & FieldName & " = " & Chr(39) & fieldvalue & Chr(39))
        End If
        ArgCount = ArgCount + 1
    End If
End Sub

Sub AddToWherelike(fieldvalue As Variant, FieldName As String, MyCriteria As String, ArgCount As Integer)
    If fieldvalue <> "" Then
        If ArgCount > 0 Then
            MyCriteria = MyCriteria & " and "
        End If
        If IsNumeric(fieldvalue) Then
            MyCriteria = (MyCriteria & FieldName & " = " & fieldvalue)
        Else
            MyCriteria = (MyCriteria & FieldName & " like " & Chr(39) & fieldvalue & Chr(42) & Chr(39))
        End If
        ArgCount = ArgCount + 1
    End If
End Sub

Sub addtowherecenter(fieldvalue As Variant, FieldName As String, MyCriteria As String, ArgCount As Integer)
    If fieldvalue <> "" Then
        If ArgCount > 0 Then
            MyCriteria = MyCriteria & " and "
        End If
        If IsNumeric(fieldvalue) Then
            MyCriteria = (MyCriteria & FieldName & " = " & fieldvalue)
        Else
            MyCriteria = (MyCriteria & FieldName & " like " & Chr(39) & Chr(42) & fieldvalue & Chr(42) & Chr(39))
        End If
        ArgCount = ArgCount + 1
    End If
End Sub

Sub AddToWherenombre(fieldvalue As Variant, FieldName As String, MyCriteria As String, ArgCount As Integer)
    If fieldvalue <> 0 Then
        If ArgCount > 0 Then
            MyCriteria = MyCriteria & " and "
        End If
        If IsNumeric(fieldvalue) Then
            MyCriteria = (MyCriteria & FieldName & " = " & fieldvalue)
        Else
            MyCriteria = (MyCriteria & FieldName & " = " & Chr(39) & fieldvalue & Chr(39))
        End If
        ArgCount = ArgCount + 1
    End If
End Sub

 

[magdidir]

 الاخ الرائع @Foksh

تسلم ايدك يا النشمي 

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

 

 

[Foksh]

37 دقائق مضت, magdidir said:

 الاخ الرائع @Foksh

تسلم ايدك يا النشمي 

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

 

 

حياك الله أخوي @magdidir .. أقل ما يمكننا فعله هو المساعدة  .