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

تم التجربة والبرنامج يعمل بلا أخطاء

تفضل Dim filePath As String filePath = CurrentProject.Path & "\Report.xlsx" DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Q", filePath, True With CreateObject("Excel.Application"): .Workbooks.Open filePath: .Sheets(1).UsedRange.Borders.Weight = 2: .Visible = True: End With

تفضل بالتوفيق fil (1).accdb

صحيح مازلنا نتعلم

للأسف، إذا تم تعيين الصورة مباشرة كخلفية في Access (بدون ربطها بملف خارجي)، فإن استخراجها يصبح معقدًا لأن الصورة مشفرة داخل قاعدة البيانات. يمكن حفظ النموذج ومسح البيانات والعمل عليه والله أعلم

التدرج اللونى لخلفية النموذج المرفق عبارة عن صورة و ليس لون من خصائص النموذج اختار تنسيق ستظهر انها صورة

هل هذا ما تريد واذا كنت تريد ان يكون حقل الاجراء ما يكون فاضي ضع فى الحقل الاجراء Not Is Null مثال.rar

تفضل هل هذا ما تريد الاستعلام Qza2 مثال.rar

تفضل SavedPath = """" & CurrentProject.Path & "\Public_Library\" & Me.Book_Name & "\r.pdf" & """" SavedPath = CurrentProject.Path & "\Public_Library\" & Me.Book_Name & "\r.pdf"

تفضل تم اضافة Me![نوع المنتج].Undo Private Sub نوع_المنتج_BeforeUpdate(Cancel As Integer) Select Case Me![نوع المنتج].Value Case "تويوتا", "جيب", "نيسان", "هونداي" ' النوع صحيح Case Else MsgBox "النوع المدخل غير صحيح. يرجى إدخال أحد الأنواع التالية: تويوتا، جيب، نيسان، هونداي.", vbExclamation, "خطأ في الإدخال" Cancel = True Me![نوع المنتج].Undo End Select End Sub

تفضل بالتوفيق Private Sub نوع_المنتج_BeforeUpdate(Cancel As Integer) Dim carType As String carType = Me![نوع المنتج].Value ' التحقق من النوع المدخل باستخدام Select Case Select Case carType Case "تويوتا", "جيب", "نيسان", "هونداي" ' النوع المدخل صحيح، لا شيء يحتاج إلى فعله Case Else MsgBox "النوع المدخل غير صحيح. يرجى إدخال أحد الأنواع التالية: تويوتا، جيب، نيسان، هونداي.", vbExclamation, "خطأ في الإدخال" Cancel = True ' إلغاء التحديث End Select End Sub أو Private Sub نوع_المنتج_BeforeUpdate(Cancel As Integer) Select Case Me![نوع المنتج].Value Case "تويوتا", "جيب", "نيسان", "هونداي" ' النوع صحيح Case Else MsgBox "النوع المدخل غير صحيح. يرجى إدخال أحد الأنواع التالية: تويوتا، جيب، نيسان، هونداي.", vbExclamation, "خطأ في الإدخال" Cancel = True End Select End Sub ينصح بتغيير اسم الحقول الى الانجليزية

أستاذى @ابوخليل عند استخدم الدالة 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