تعديل في كود البحث

[رمهان]

اخي @فايز..

ليش تركت كود الاخت زهره وانا عدلت عليه ... هل مازبط ؟

لانه يحوي فكره زهريه وهي البحث في المكرر واعلامك بآخر سجل 

بالتوفيق

[عفرنس]

1 ساعه مضت, رمهان said:

اخي @فايز..

ليش تركت كود الاخت زهره وانا عدلت عليه ... هل مازبط ؟

لانه يحوي فكره زهريه وهي البحث في المكرر واعلامك بآخر سجل 

بالتوفيق

سأعاود النظر فيه وأوافيك النتائج 

@jjafferr 

تفضل ياصاحبي

CS_SeetNumberLabels (2).xlsx

[عفرنس]

23 ساعات مضت, رمهان said:

@فايز..

@ابوآمنة

هذا تعديل على كود الاستاذه زهره ولماطلبت بنفس الرسائل 

Dim strSearch As String
Dim rs As Object
Set rs = Me.RecordsetClone
   
   If IsNull(Me![txtSearch]) Or (Me![txtSearch]) = "" Then
          MsgBox "رجاء ادخل اسم للبحث عنه", vbOKOnly, "خطأ في البحث"
          Me![txtSearch].SetFocus
   Exit Sub
   End If
   strSearch = Me![txtSearch]
  
   With rs
  .FindNext "[EmpName] like '*" & strSearch & "*'"
   
   If Not .EmpName Like "*" & strSearch & "*" Then
          MsgBox "لا يوجد سجل بهذا الإسم :  " & strSearch, , "غير موجود"
          Me.txtSearch = ""
          Me![txtSearch].SetFocus
   ElseIf .NoMatch Then
          MsgBox "آخر سجل في البحث عن :  " & strSearch, , "آخر سجل"
          Me.cmdSearch.Caption = "بحث"
          Me.txtSearch = ""
          Me![txtSearch].SetFocus
          Me.cmdSearch.ForeColor = RGB(0, 0, 255)
  DoCmd.GoToRecord , , acFirst
   Else
   Me.Bookmark = .Bookmark
          MsgBox "تم ايجاد اسم :  " & strSearch, , "مبروك"
          Me.cmdSearch.Caption = "اكمال البحث"
          Me.cmdSearch.ForeColor = RGB(255, 0, 0)
   End If
   End With

rs.Close
Set rs = Nothing

بالتوفيق

شكرا لك .. على جهدك وتعبك معي أخي @رمهان 

عندي ملاحظة  : 

وهي/ تكرار الرسالة ( تم إيجاد الاسم ) عند كل اسم .. نريد ان يكتفى بها في المرة الأولى فقط عند العثور على الاسم المطلوب .

 

[رمهان]

2 ساعات مضت, فايز.. said:

شكرا لك .. على جهدك وتعبك معي أخي @رمهان 

عندي ملاحظة  : 

وهي/ تكرار الرسالة ( تم إيجاد الاسم ) عند كل اسم .. نريد ان يكتفى بها في المرة الأولى فقط عند العثور على الاسم المطلوب .

 

@فايز..

ممكن عمل طلبك ولكن هي مفيده لو اصبح لديك اكثر من سجل يطابق بحثك ؟ فلايجاد المطابق الثاني ستنقر على "اكمال البحث" وهكذا حتى تنتهي الى اخر سجل وسيتم تنبيهك كذلك ؟ وهنا سر الفكرة الزهريه وصدقني انا لما مريت هنا هو اعجابي بالكود الزهري .

هذا وان كنت متاكد من رغبتك في ازالة المسج عد وسنعود !

تحياتي

[عفرنس]

8 ساعات مضت, رمهان said:

@فايز..

ممكن عمل طلبك ولكن هي مفيده لو اصبح لديك اكثر من سجل يطابق بحثك ؟ فلايجاد المطابق الثاني ستنقر على "اكمال البحث" وهكذا حتى تنتهي الى اخر سجل وسيتم تنبيهك كذلك ؟ وهنا سر الفكرة الزهريه وصدقني انا لما مريت هنا هو اعجابي بالكود الزهري .

هذا وان كنت متاكد من رغبتك في ازالة المسج عد وسنعود !

تحياتي

أخي الفاضل : @رمهان 

من وجهة نظري القاصرة أن يكتفى بالرسالة لأول مرة في إيجاد الاسم ولا داعي لباقي المرات . 

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

لذلك نريد أن نتفادى هذه المشكلة ( إغلاق الفورم ) من أجل البحث مرة أخرى .

فلو هناك حل لها فلا تبخل علينا به .. 

دمت بود . 

[رمهان]

@فايز..

تفضل 

Dim strSearch As String
static xn
Dim rs As Object
Set rs = Me.RecordsetClone
   
   If IsNull(Me![txtSearch]) Or (Me![txtSearch]) = "" Then
          MsgBox "رجاء ادخل اسم للبحث عنه", vbOKOnly, "خطأ في البحث"
          Me![txtSearch].SetFocus
   Exit Sub
   End If
   strSearch = Me![txtSearch]
  
   With rs
  .FindNext "[EmpName] like '*" & strSearch & "*'"
   
   If Not .EmpName Like "*" & strSearch & "*" Then
          MsgBox "لا يوجد سجل بهذا الإسم :  " & strSearch, , "غير موجود"
          Me.txtSearch = ""
          Me![txtSearch].SetFocus
   ElseIf .NoMatch Then
          MsgBox "آخر سجل في البحث عن :  " & strSearch, , "آخر سجل"
          Me.cmdSearch.Caption = "بحث"
          Me.txtSearch = ""
          Me![txtSearch].SetFocus
          Me.cmdSearch.ForeColor = RGB(0, 0, 255)
  DoCmd.GoToRecord , , acFirst
   Else
xn=xn+1
   Me.Bookmark = .Bookmark
          if xn=1 then MsgBox "تم ايجاد اسم :  " & strSearch, , "مبروك"
          Me.cmdSearch.Caption = "اكمال البحث"
          Me.cmdSearch.ForeColor = RGB(255, 0, 0)
   End If
   End With

rs.Close
Set rs = Nothing

بالتوفيق

[عفرنس]

2 ساعات مضت, رمهان said:

@فايز..

تفضل 

Dim strSearch As String
static xn
Dim rs As Object
Set rs = Me.RecordsetClone
   
   If IsNull(Me![txtSearch]) Or (Me![txtSearch]) = "" Then
          MsgBox "رجاء ادخل اسم للبحث عنه", vbOKOnly, "خطأ في البحث"
          Me![txtSearch].SetFocus
   Exit Sub
   End If
   strSearch = Me![txtSearch]
  
   With rs
  .FindNext "[EmpName] like '*" & strSearch & "*'"
   
   If Not .EmpName Like "*" & strSearch & "*" Then
          MsgBox "لا يوجد سجل بهذا الإسم :  " & strSearch, , "غير موجود"
          Me.txtSearch = ""
          Me![txtSearch].SetFocus
   ElseIf .NoMatch Then
          MsgBox "آخر سجل في البحث عن :  " & strSearch, , "آخر سجل"
          Me.cmdSearch.Caption = "بحث"
          Me.txtSearch = ""
          Me![txtSearch].SetFocus
          Me.cmdSearch.ForeColor = RGB(0, 0, 255)
  DoCmd.GoToRecord , , acFirst
   Else
xn=xn+1
   Me.Bookmark = .Bookmark
          if xn=1 then MsgBox "تم ايجاد اسم :  " & strSearch, , "مبروك"
          Me.cmdSearch.Caption = "اكمال البحث"
          Me.cmdSearch.ForeColor = RGB(255, 0, 0)
   End If
   End With

rs.Close
Set rs = Nothing

بالتوفيق

اقتباس

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

لذلك نريد أن نتفادى هذه المشكلة ( إغلاق الفورم ) من أجل البحث مرة أخرى .

أخي @رمهان 

لا أدري إن كنت انتبهت لهذه أم لا ؟؟ 

 

[ابوآمنة]

مساهمة مع أخي رمهان 

أضف بعد هذه هذه السطر  DoCmd.GoToRecord , , acFirst  هذا الكود

          rs.MoveFirst

شاهد المرفق

Posters5.zip

[رمهان]

ياسلام عليك @ابوآمنة

وزياده شوية نضيف xn=0   بعد rs.movefirst  لكي برضه رساله واحده للبحث الثاني

بالتوفيق

[عفرنس]

16 دقائق مضت, ابوآمنة said:

مساهمة مع أخي رمهان 

أضف بعد هذه هذه السطر  DoCmd.GoToRecord , , acFirst  هذا الكود

          rs.MoveFirst

شاهد المرفق

Posters5.zip 100.13 kB · 0 تنزيلات

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

لي طلب منك أخي @رمهان و الأخ  @ابوآمنة

لو نظرتما لي في الكود الموجود في محرر الأكواد  .. تحديدا الكود الموجود في ( Public Sub Find() )  .. هل فيه شيء مكرر لا فائدة منه ، عن الكود الأعلى منه الخاص بزر بحث ؟؟ 

شاكر ومقدر لكما .. 

Posters.rar

[رمهان]

@فايز..

لم استطع فتح الملف لعدم وجود نسخة محدثة لدي لبرنامج الضغط

[عفرنس]

تفضل

Posters.accdb

تم تعديل أبريل 14, 2020 بواسطه فايز..

[رمهان]

تفضل اخي @فايز.. والشكر موصول للاستاذ @ابوآمنة

مزحه : تقول ماشفتها وانا لقيتها في ملغك الاخير هذا اخي فايز

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

Posters.accdb

[عفرنس]

@ابوآمنة @رمهان شكر الله لكما .. يستحق كل واحد منكما صبية فتية .