هدية قاعدة اراضي مضمنة بطلب مساعدة منكم

استبدل السطر الخاص بهذا الحقل بدالة جديدة اسمها AddToWhere2

كما هي هنا

مع الاحتفاظ بالدالة الاصلية AddToWhere كما هي لتستخدم فى باقي الاسطر

Function BuildCriteria()
  On Error Resume Next
 Dim ArgCount As Integer

  ArgCount = 0
 MyCriteria = ""

 AddToWhere2 Forms![search]![f1], "[units]![p1] ", MyCriteria, ArgCount
 AddToWhere Forms![search]![f2], "[units]![p2] ", MyCriteria, ArgCount
 AddToWhere Forms![search]![f3], "[units]![p3] ", MyCriteria, ArgCount
 AddToWhere Forms![search]![f4], "[units]![p4] ", MyCriteria, ArgCount
 AddToWhere Forms![search]![f5], "[units]![p5] ", MyCriteria, ArgCount
 AddToWhere Forms![search]![f6], "[units]![p6] ", MyCriteria, ArgCount
 AddToWhere Forms![search]![f7], "[units]![p7] ", MyCriteria, ArgCount
 AddToWhere Forms![search]![f8], "[units]![p8] ", MyCriteria, ArgCount
 AddToWhere Forms![search]![f9], "[units]![p9] ", MyCriteria, ArgCount
 AddToWhere Forms![search]![f10], "[units]![p10] ", MyCriteria, ArgCount
 AddToWhere Forms![search]![f11], "[units]![p11] ", MyCriteria, ArgCount
 AddToWhere Forms![search]![f12], "[units]![p12] ", MyCriteria, ArgCount
 AddToWhere Forms![search]![f13], "[units]![p13] ", MyCriteria, ArgCount
 AddToWhere Forms![search]![f14], "[units]![p14] ", MyCriteria, ArgCount
 AddToWhere Forms![search]![f15], "[units]![p15] ", MyCriteria, ArgCount
 AddToWhere Forms![search]![f18], "[units]![p18] ", MyCriteria, ArgCount


End Function

Public Sub AddToWhere2(FieldValue As Variant, FieldName As String, MyCriteria As String, ArgCount As Integer)
'chr(32) = '
'chr(42) = *
If FieldValue <> "" Then
  If ArgCount > 0 Then
    MyCriteria = MyCriteria & "and"
  End If
  MyCriteria = (MyCriteria & FieldName & " like " & Chr(39) & FieldValue & Chr(39))
  ArgCount = ArgCount + 1
 End If
End Sub

شكرا اخ محمد اتبعت ما كتبته وعمل بشكل ممتاز

اشكرك جدا .

تحياتي

اخ محمد طاهر

اخر شي اكتشفت مشكله في طباعة نتيجة البحث

حنما اترك حقول البحث في فورم search فارغه واضغط

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

يعني اذا لم يكن اي حقل من حقول البحث الفارغه فيه

بيانات حتى لو واحد منها يتم طباعة التقرير كاملا .

يمكن فهمتني بس افتح نموذج البحث عندك وبدون ما تعمل

بحث اظغط على زر امر طباعة التقرير وسوف ترى النتيجه ..

وشكرا جزيلا .

وانا في انتظار الحل

هذا طبيعي

فمادمت لم تحدد محدد للبحث ، فالطبيعي أن يظهر كل البيانات

أما ان لم تكن تريد ذلك:

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

If MyCriteria = "" then 
msgbox "no criteria selected"
exit sub
end if

اخي محمد لافائدة

حيث تظهر رسالة ثم اضغط على موافق فيكمل الطباعة

يعني لم يتغير شيئ . لو انه تكون هذه الرساله بمجرد

اضغط على موافق فيلغي عملية الطباعة لكان افضل بكثير ..

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

ان جملة

Exit Sub

توقف تنفيذ ال SUB بالكامل

فاذا وضعت الكود السابق فى بداية الكود الخاص بالطباعة

فلن يطبع التقرير

فقط تأكد انه فىالبداية

للتأكد انه فى البداية

Private Sub Command13_Click()

If MsgBox("  áÇ íæÌÏ ãÍÏÏÇÊ ááÈÍË åá ÊÑíÏ ÇÙåÇÑ ÌãíÚ ÇáÓÌáÇÊ ", vbYesNo, _
   " ÊÃßíÏ ÇÎÊíÇÑ ãÍÏÏÇÊ ÇáÈÍË") = vbNo Then
   Cancel = True
   SendKeys "{ESC}"
   Exit Sub
End If


On Error GoTo Err_Command13_Click
'MsgBox MyCriteria
Me.Visible = False
BuildCriteria

Dim stDocName As String
stDocName = "m"
DoCmd.OpenReport stDocName, acPreview, , MyCriteria

Exit_Command13_Click:
    Exit Sub

Err_Command13_Click:
    MsgBox Err.Description
    Resume Exit_Command13_Click

End Sub

اخ محمد انا ماتكد من انني ازعجتك ولكن لم يعمل معي كما اريد

انا .

المشكله انك وضعت رسالة نعم او لا في زر امر الطباعة

وهذه الرساله تظهر سواء كان هناك بيانات ام لم يكن .

انا اريدها في التقرير حيث تظهر زي هذا الكود

If MyCriteria = "" then

msgbox "no criteria selected"

exit sub

end if

الرساله التي تظهر في هذا الكود محكومه بكلمة موافق

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

كاملا انا اريد حيمنا اظغط على موافق يلغي الطباعة نهائيا

امل انني شرحت ما اريد بالضبط

وانا في انتظارك

If MsgBox("  لا يوجد محددات للبحث هل موقف طباعة التقرير ,  و الا ستطبع جميع البيانات ", vbYesNo, _
   " تأكيد اختيار محددات البحث") = vbYes Then
   Cancel = True
   SendKeys "{ESC}"
   Exit Sub
End If

انا اسف كان من المفروض ان ارد عليك لكن ظروي حالت

دون ذلك اخي افاضل . لقد عمل معي الكود فعلا

وكنت اواجه مشكله حينما اقوم بمسح البحث

واعود بالظغط على امر طباعة النتائج يطبع لي اخر

بحث عملته . وعند الظغط الاثنيه على نفس زر الطباعة يعطيني

رسالة بعدم وجود بينات في البحث .

فصارت الضغظ الاول على زر الطباعة بعد مسح البحث مشكله

ولكن بعد جهد جهيد اظفت دالة ()search= الى زر مسح البحث

عند حدث فقدان التركيز فسار كل شي على ما يرام ..

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

وجزاك الله خير الجزاء

:D

Private Sub Command13_Click()

BuildCriteria

If MyCriteria = "" Then
If MsgBox("  لا يوجد محددات للبحث هل نوقف طباعة التقرير ,  و الا ستطبع جميع البيانات ", vbYesNo, _
   " تأكيد اختيار محددات البحث") = vbYes Then
   Cancel = True
   SendKeys "{ESC}"
   Exit Sub
End If
End If

On Error GoTo Err_Command13_Click
Me.Visible = False
BuildCriteria

Dim stDocName As String
stDocName = "m"
DoCmd.OpenReport stDocName, acPreview, , MyCriteria

Exit_Command13_Click:
    Exit Sub

Err_Command13_Click:
    MsgBox Err.Description
    Resume Exit_Command13_Click

End Sub