kanory

بعد نسخ الشيفرة ولصقها في النموذج لديك استدعي كود الفتح بهذه الصورة Private Sub Compact_Click() Dim path As String path = "E:\Auto\ddbee$" ' مسار قاعدة البيانات call CompactAndRepairDatabase Shell "MSACCESS.EXE " & path, vbNormalFocus End Sub

اولا هل تقوم بإجراء نسخ احتياطية لبياناتك قبل الضغط والإصلاح لان لاي سبب حصل خطأ قد تفقد بياناتك ... على كل حال هذه الشيفرة تقوم باللازم اقصد الضغط والإصلاح Sub CompactAndRepairDatabase() Dim dbPath As String Dim tempDbPath As String ' المسار الكامل لقاعدة البيانات الأصلية dbPath = "E:\Auto\dbbee.accdb" ' إنشاء مسار مؤقت لقاعدة البيانات بعد الإصلاح tempDbPath = "E:\Auto\dbbee_temp.accdb" ' تأكد من أن قاعدة البيانات الأصلية موجودة If Dir(dbPath) <> "" Then ' إجراء عملية Compact and Repair On Error Resume Next Application.CompactRepair SourceFile:=dbPath, DestinationFile:=tempDbPath, LogFile:=False If Err.Number = 0 Then ' استبدال قاعدة البيانات الأصلية بالنسخة الجديدة Kill dbPath ' حذف قاعدة البيانات الأصلية Name tempDbPath As dbPath ' إعادة تسمية النسخة المؤقتة إلى الأصلية MsgBox "تم إصلاح قاعدة البيانات بنجاح!", vbInformation Else MsgBox "حدث خطأ أثناء الإصلاح: " & Err.Description, vbCritical End If On Error GoTo 0 Else MsgBox "قاعدة البيانات غير موجودة في المسار المحدد!", vbExclamation End If End Sub

دالة DoCmd.OpenDataAccessPage تُستخدم لفتح صفحات الوصول إلى البيانات (Data Access Pages) وليس لفتح قاعدة بيانات خارجية. لفتح قاعدة بيانات أخرى، يمكنك استخدام دالة Application.OpenCurrentDatabase أو دالة Shell Application.OpenCurrentDatabase "E:\Auto\dbbee.accdb" إذا كنت تريد تشغيل قاعدة البيانات كملف منفصل باستخدام Shell Dim path As String path = "E:\Auto\dbbee.accdb" ' مسار قاعدة البيانات Shell "MSACCESS.EXE " & path, vbNormalFocus

دائما ابحث عن حل كامل لمشاكل برامجك .... لا ترضي بانصاف الحلول ..... لو عرضت لنا تلك المسميات لربما تجد الحل من احد اعضاء المنتدى فيصبح لديك حل 100 % تفضل انظر الجدول .. ليس فيه مسارات .... وانظر الى مجلد الصور فيه الصور باسماء ارقام تلك السجلات فقط ... ولكن تحتاج الى تعديل زر الاضافة والحذف لم يسمح وقتي بذلك التعديل 555.rar

ممكن الاستغناء عن إضافة المسارات في الجدول ويتم عرضها من المجلد مباشرة بمعرفة الرقم فقط

اصنع زر في النموذج لديك ثم ادرج هذا الكود فيه ............... Dim db As DAO.Database Dim rs As DAO.Recordset Dim oldPicPath As String Dim newPicPath As String Dim FirstName As String Dim keyVal As String Dim desktopPath As String Dim sourceFolder As String Dim destFolder As String Dim fileSystem As Object desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") sourceFolder = desktopPath & "\555\Pic1\" ' المجلد المصدر destFolder = desktopPath & "\555\Pictures\" ' المجلد الوجهة Set fileSystem = CreateObject("Scripting.FileSystemObject") If Not fileSystem.FolderExists(destFolder) Then fileSystem.CreateFolder destFolder End If Set db = CurrentDb Set rs = db.OpenRecordset("Table1", dbOpenDynaset) Do While Not rs.EOF If IsNull(rs!Pic2) Or rs!Pic2 = "" Then FirstName = rs!FirstName keyVal = rs!Key If Not IsNull(FirstName) And Not IsNull(keyVal) Then oldPicPath = sourceFolder & FirstName & ".jpg" newPicPath = destFolder & keyVal & ".jpg" If fileSystem.FileExists(oldPicPath) Then fileSystem.MoveFile oldPicPath, newPicPath rs.Edit rs!Pic2 = newPicPath rs.Update End If End If End If rs.MoveNext Loop rs.Close Set rs = Nothing Set db = Nothing Set fileSystem = Nothing MsgBox "تم نقل الصور وتحديث الحقل Pic2 بنجاح", vbInformation

وعليكم السلام ورحمة الله وبركاته لاحظ الشرح ثم استخدم هذا ................ Private Sub NEM_SH_NotInList(NewData As String, Response As Integer) Dim db As DAO.Database Dim rs As DAO.Recordset Dim MsgBoxResult As VbMsgBoxResult MsgBoxResult = MsgBox("العنصر '" & NewData & "' غير موجود. هل ترغب في إضافته؟", vbYesNo + vbQuestion, "إضافة عنصر جديد") If MsgBoxResult = vbYes Then Set db = CurrentDb Set rs = db.OpenRecordset("SH", dbOpenDynaset) NewID = Nz(DMax("ID_SH", "SH"), 0) + 1 rs.AddNew rs!ID_SH = NewID rs!ASASE = NewData rs.Update rs.Close Set rs = Nothing Set rs1 = Nothing Set db = Nothing Response = acDataErrAdded Else Response = acDataErrContinue End If End Sub

مشاركة مع الاخوة .... هل الكود السابق الذي لديك تصدر التقرير ويطبع في نفس الوقت .... ام انت تطبع يدويا ... استخدم طريقة التصدير ثم الطباعة عن طريق الكود مباشرة دون تدخل منك

طيب جرب التعديل الجديد ربما يعجبك ............. 1 (11).accdb

تفضل اضغط دبل كليك على الحقل وعلمنا ..... 1 (11).accdb

بارك الله فيك @MO87

جرب هذا Dim searchText As String Dim fieldValue As String ' النص الذي تبحث عنه searchText = "Ca" ' أدخل الكلمة أو جزء الكلمة المراد البحث عنها fieldValue = Nz(Me!Field1, "") ' جلب القيمة من الحقل Field1 مع التعامل مع القيم الفارغة ' التحقق إذا كانت القيمة تحتوي على النص المطلوب If InStr(1, fieldValue, searchText, vbTextCompare) > 0 Then ' فتح النموذج Form1 إذا تحقق الشرط DoCmd.OpenForm "Form1" Else ' عرض رسالة توضيحية إذا لم يتحقق الشرط MsgBox "الحقل لا يحتوي على النص المطلوب.", vbInformation, "تحذير" End If

لا يحتاج لاستئذان اخي الفاضل .. كل ما ينشر هو وقف للجميع بارك الله فيك

استاذي الغالي الدروب بوكس ايضا تستطيع من خلاله قراءة النصوص .... جرب المرفق ووافني بالنتيجة .... KAN_1.accdb

بارك الله فيك استاذي الفاضل @Foksh اشكرك على الشرح الوافي جزاك الله خير وكتب أجرك على ما تقدمة رحم الله والدك ووالدينا وجميع المسلمين الاحياء والاموات

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

اخي الكريم بارك الله فيك احسن الظن باخوانك اولا معظم مواضيع السابقة وجدت لها الحل من قبل الاعضاء الاكارم وعملت انت عليها عملية صح اذا كان هناك موضوع واحد لم تجد له الإجابة فأكيد وتأكد أن الإخوة الأعضاء مروا وشاهدوا ولم يستطيعوا فهم أو حل موضوعك والسبب بالإضافة لما ذكر اخي @ابوخليل انك لم تدرج سجلات للتجربة عليها

اقرأ هذا الموضوع .....................

تفضل ..... Private Sub Command_Click() Call DeleteImageFiles DoCmd.Quit End Sub Sub DeleteImageFiles() Dim fso As Object Dim folderPath As String Dim file As Object ' تحديد مسار المجلد المطلوب folderPath = CurrentProject.Path & "\Data\QR_images\" ' التأكد من وجود المجلد If Dir(folderPath, vbDirectory) = "" Then MsgBox "المجلد غير موجود: " & folderPath, vbExclamation, "خطأ" Exit Sub End If ' إنشاء كائن FileSystemObject Set fso = CreateObject("Scripting.FileSystemObject") ' التحقق من الملفات داخل المجلد For Each file In fso.GetFolder(folderPath).Files ' التحقق إذا كان الملف صورة (حسب الامتداد) If LCase(file.Name) Like "*.jpg" Or _ LCase(file.Name) Like "*.jpeg" Or _ LCase(file.Name) Like "*.png" Or _ LCase(file.Name) Like "*.bmp" Or _ LCase(file.Name) Like "*.gif" Then ' حذف الملف file.Delete True End If Next file MsgBox "تم حذف جميع ملفات الصور بنجاح!", vbInformation, "عملية ناجحة" ' تحرير الكائنات Set fso = Nothing End Sub

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

اولا : اخي اختر العنوان المناسب لموضوعك ثانيا : غير مفهوم طلبك .... هل تريد علامة التبويب تصبح من اليمن لليسار ..... لان الصورة مختلفة عن الموجود في المرفق ؟؟؟؟؟

ممكن تدرج لنا هذه المكتبة حتى نجرب المرفق ZatcaUBLXMLGenerator

تابع هذا الموضوع