محمد احمد لطفى

أستاذى @ابوخليل عند استخدم الدالة NOW فإن وجود الفواصل (/ و : سيؤدي إلى عدم إمكانية حفظ الملف، نظرًا لأن نظام الملفات لا يسمح بهذه الرموز في أسماء الملفات

تفضل pdf Dim fileName As String fileName = Me.Namea & " - " & Format(Now(), "yyyy-mm-dd") & " " & Format(Now(), "hh mm AM/PM") & ".pdf" DoCmd.OutputTo acOutputReport, namerpts, acFormatPDF, fileName, True, , , acExportQualityPrint Word Dim fileName As String fileName = Me.Namea & " - " & Format(Now(), "yyyy-mm-dd") & " " & Format(Now(), "hh mm AM/PM") & ".doc" DoCmd.OutputTo acOutputReport, namerpts, acFormatRTF, fileName, True, , , acExportQualityPrint شريط طباعة.rar

تفضل بالتوفيق عن طريق التنسيق الشرطى test13102024.rar

تفضل بالتوفيق test8102024.rar

غير Dim i, ii As Integer الى Dim i As Long, ii As Long استبدلت المتغيرين i و ii بنوع Long للتعامل مع أرقام أكبر من 4 خانات. الخطأ "Run-time error 6" يتعلق بتجاوز الحد الأقصى لنوع البيانات Integer. أن شاء الله هو الحل بالتوفيق

تفضل بالتوفيق DoCmd.SetWarnings False 'On Error GoTo errhld: Dim Arr() As String Dim i As Long Arr = Split(Str) FnSearch = "عدم وجود المطلوب" ' القيمة الافتراضية إذا لم يتم العثور على شيء For i = 0 To UBound(Arr) If i + 8 <= UBound(Arr) Then If Nz(DLookup("LikeA", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & " " & Trim(Arr(i + 2)) & " " & Trim(Arr(i + 3)) & " " & Trim(Arr(i + 4)) & " " & Trim(Arr(i + 5)) & " " & Trim(Arr(i + 6)) & " " & Trim(Arr(i + 7)) & " " & Trim(Arr(i + 8)) & "'"), 0) <> 0 Then FnSearch = DLookup("LikeB", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & " " & Trim(Arr(i + 2)) & " " & Trim(Arr(i + 3)) & " " & Trim(Arr(i + 4)) & "'") Exit For End If End If If i + 3 <= UBound(Arr) Then If Nz(DLookup("LikeA", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & " " & Trim(Arr(i + 2)) & " " & Trim(Arr(i + 3)) & "'"), 0) <> 0 Then FnSearch = DLookup("LikeB", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & " " & Trim(Arr(i + 2)) & " " & Trim(Arr(i + 3)) & "'") Exit For End If End If If i + 2 <= UBound(Arr) Then If Nz(DLookup("LikeA", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & " " & Trim(Arr(i + 2)) & "'"), 0) <> 0 Then FnSearch = DLookup("LikeB", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & " " & Trim(Arr(i + 2)) & "'") Exit For End If End If If i + 1 <= UBound(Arr) Then If Nz(DLookup("LikeA", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & "'"), 0) <> 0 Then FnSearch = DLookup("LikeB", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & "'") Exit For End If End If If i <= UBound(Arr) Then If Nz(DLookup("LikeA", "KindX", "LikeA='" & Trim(Arr(i)) & "'"), 0) <> 0 Then FnSearch = DLookup("LikeB", "KindX", "LikeA='" & Trim(Arr(i)) & "'") Exit For End If End If Next i errhld = Nz(DLookup("KindX", "TableX", "[NameX] Like '" & SetName & "'"), "غير مسجل")

مثل ما أشار عليه أستاذى ابو جودى ( اى برامج يتم تصميمها بالشكل الطبيعى تعمل على النواتان يا دكتور بدون اى مشاكل ) الملف المرفق يعمل على النواتين

جهد مشكور بارك الله فيك

قم بادراج ملف مرفق مثال لعمل المطلوب

تفضل هل هذا ما تقصد Dim qdf As DAO.QueryDef Dim fld As DAO.Field Dim fieldName As String Dim fieldExists As Boolean fieldName = "b0" On Error Resume Next Set qdf = CurrentDb.QueryDefs("QForExport") On Error GoTo 0 If qdf Is Nothing Then MsgBox "The query QForExport does not exist." Exit Sub End If For Each fld In qdf.Fields If fld.Name = fieldName Then fieldExists = True Exit For End If Next fld If fieldExists Then MsgBox "The field (" & fieldName & ") exists." Else Beep MsgBox "The field (" & fieldName & ") does not exist." End If و قد يختلف الأمر اذا كان الاستعلام يحتوى على أكثر من جدول به نفس اسم الجقل كما أشار أستاذى أبو خليل TTTEst.mdb

تفضل بالتوفيق Shift: Shift = 1 Ctrl: Shift = 2 Alt: Shift = 4 If KeyCode = 66 And Shift = 1 Then or If KeyCode = vbKeyB And Shift = 1 Then If KeyCode = 67 And Shift = 2 Then or If KeyCode = vbKeyc And Shift = 2 Then

ربنا يشفيه ويعافيه شفاء لا يغادر سقما

مشاركة مع أساتذتى فى حدث عند الطباعة Private Sub Report_Page() Me.DrawWidth = 10 Me.Line (0, 0)-(Me.ScaleWidth, Me.ScaleHeight), , B Me.DrawWidth = 20 Me.Line (20, 20)-(Me.ScaleWidth - 20, Me.ScaleHeight - 20), , B End Sub

تفضل قمت بالتنفيذ فى حقل name1 نفذ نفس الفكرة فى باقى الحقول بالتوفيق تلوين النصوص الفارغة.mdb

سؤال التقرير فيه صفحات ممتلئة و صفحات فارغة واذا كانت الاجابة التقرير لا يوجد بيانات اكتب مباشرة DoCmd.CancelEvent

تفضل بالتوفيق في حدث "On NoData" اكتب msgbox "لا توجد بيانات" cancel=true أو MsgBox "لا توجد بيانات في التقرير", , "تنبيه" DoCmd.CancelEvent

المشكلة عادة تكون فى لغة الويندوذ راجع هذه المشاركة

أستاذ @jo_2010 Public Function Jo_2010 () Forms("YourFormName").Controls("P_Day").SourceObject = "NewPU" Forms("YourFormName").Controls("P_Day").Form.Controls("TN").Caption = "Urine" Dim myfilter As String myfilter = "[TName]='" & "Urine" & "'" Forms("YourFormName").Controls("P_Day").Form.Filter = myfilter Forms("YourFormName").Controls("P_Day").Form.FilterOn = True Forms("YourFormName").Controls("JO") = 3 Forms("YourFormName").Controls("U_OK").Requery End Function قم بتغيير YourFormName باسم النموذج المراد العمل عليه أو Public Function Jo_2010 () Dim frm As Form Set frm = Screen.ActiveForm ' النموذج الحالي If Not frm Is Nothing Then frm.Controls("P_Day").SourceObject = "NewPU" frm.Controls("P_Day").Form.Controls("TN").Caption = "Urine" Dim myfilter As String myfilter = "[TName]='" & "Urine" & "'" frm.Controls("P_Day").Form.Filter = myfilter frm.Controls("P_Day").Form.FilterOn = True frm.Controls("JO") = 3 frm.Controls("U_OK").Requery Else MsgBox "No active form found.", vbExclamation End If End Function مفترض أن يعلم النموذج الذى سيتم العمل علية لم أقوم بالتجريب لانه لا يوجد مرفق

تفضل بالتوفيق Show Hide Icon Desk Top.mdb

اللغة العربية

تفضل

أسف للخطا IIF([eltkeem_elam] = 'غ' AND [stuehoa] = 'ذكر'; 'ناجح بحكم القانون';IIF([eltkeem_elam] = 'غ' AND [stuehoa] = 'انثى'; 'ناجحة بحكم القانون';IIF([eltkeem_elam] = 'ح' AND [stuehoa] = 'ذكر'; 'ناجح';IIF([eltkeem_elam] = 'ح' AND [stuehoa] = 'انثى'; 'ناجحة'))) ناجح.accdb

تفضل IIF([eltkeem_elam] = 'غ' AND [stuehoa] = 'ذكر'; 'ناجح بحكم القانون';IIF([eltkeem_elam] = 'غ' AND [stuehoa] = 'انثى'; 'ناجحة بحكم القانون';IIF([eltkeem_elam] = 'ح' AND [stuehoa] = 'ذكر'; 'ناجح';IIF([eltkeem_elam] = 'ح' AND [stuehoa] = 'انثى'; 'ناجحة'))) لكى تصلك مساعدة سريعة يرجى كتابة الكود و ليس وضع صورة أو وضع مثال صغير شكراُ لتفهك هذا المثال من موضوع سابق لك قمت بالعمل عليه تم التعديل ناجح.accdb

تفضل Dim folderPath As String folderPath = Me.linkx ' or ' folderPath = "d:\MyFolder\" & Me.ID ' فتح المجلد Shell "explorer.exe """ & folderPath & """", vbNormalFocus ضع الامر فى حدث عند النقر على حقل المسار أو من خلال الزرار فتح المجلد كما تريد

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