د.كاف يار

اتفضل التعديل الحاق بشرط.accdb

هذا هو الكود كامل Dim DB As Object Set DB = GetObject("ضع مسار قاعدة البيانات هنا فقط") DB.Application.Quit الواضح انك تجد صعوبة في اختيار مسار القاعدة أو استخدم نفس الكود وصور رسالة الخطأ الي تظهر امامك مع العلم مسار قاعدة البيانات هي قاعدة البيانات الخلفية المفصولة عن الواجهة ضع الكود في ازرار انهاء البرنامج بحيث تضمن اغلاق الواجهات قاعدة البيانات البعيدة

غير صحيح راجع الكود ستجدني حصرت مفاتيح الإدخال فقط

اتفضل جرب هذي انشاء الله تضبط معك المهم انك تقفل جميع برامج الأوفيس قبل التثبيت اضغط هنا للتحميل من mediafire

اعطيني الكود بعد التعديل خلينا نشوف كيف استخدمته

نعم يمكن ذلك في حدث عند الفتح ضع التالي Private Sub Form_Open(Cancel As Integer) Me.KeyPreview = True End Sub و في حدث عند المفتاح للأسفل ضع التالي Private Sub form_KeyDown(KeyCode As Integer, Shift As Integer) On Error Resume Next Dim ctl As Control Select Case KeyCode Case vbKeyA To vbKeyZ DoCmd.RunCommand acCmdUndo Case vbKey0 To vbKey9 DoCmd.RunCommand acCmdUndo End Select End Sub

ارفق نسخة من برنامجك لكي يتم مساعدتك في حل المشكلة

تفضل المفتاح العلوي سنقلك للسجل السابق و يضع التركيز على حقل التاريخ Private Sub Form_Open(Cancel As Integer) On Error Resume Next Me.KeyPreview = True End Sub Private Sub form_KeyDown(KeyCode As Integer, Shift As Integer) On Error Resume Next Select Case KeyCode Case vbKeyUp DoCmd.GoToRecord , , acPrevious db.SetFocus End Select End Sub d11.accdb

اتعب و انا اقول فناااان ماشاء الله عليك شغل جدا جميل و احترافي و مرتب

وهذي مشاركتي مع اخونا @Hawiii مجرد فكرة Nouveau Microsoft Access Database.accdb ما اقدر اقول غير انك فناااااان ماشاء الله عليك

نقسم الكود لكي يسهل الشرح بهذا الكود تستطيع انشاء نسخة مماثلة لأي ملف مهما كان الامتداد Dim MyFile, DstFile As String Dim Syso As Object MyFile = File_Name ' Old File DstFile = CurrentProject.Path & "\Folder_Name\" & " New_File_Name" ' New File DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing لحذف اي ملف Kill " C:\\ File Path ....."

الكود المستخدم هو التالي On Error Resume Next Dim MyFile, DstFile As String Dim Syso As Object Dim db As DAO.Database Dim rs As DAO.Recordset '==================================== ' تحديد جدول البيانات Set rs = CurrentDb.OpenRecordset("SELECT * FROM Table1 where nategacode=2") rs.MoveFirst While (Not rs.EOF) ' استخراج اسم الملف من رابط الصورة داخل قاعدة البيانات MyFile = CurrentProject.Path & "\savefrom\" & Right$(rs.Fields("imagepath"), Len(rs.Fields("imagepath")) - InStrRev(rs.Fields("imagepath"), "\")) ' تحديد مسار المجدل الثاني و اضافة اسم الصورة المستخرج من الكود اعلاه DstFile = CurrentProject.Path & "\saveto\" & Right$(rs.Fields("imagepath"), Len(rs.Fields("imagepath")) - InStrRev(rs.Fields("imagepath"), "\")) 'البدء في انشاء نسخة مماثلة من الملف المحدد اعلاه DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") ' مسار الملف الأصلي و المسار الجديد Syso.copyfile MyFile, DstFile Set Syso = Nothing 'حذف الملف من المجلد الرئيسي بعد نسخه Kill MyFile 'تعديل المسار داخل الجدول rs.Edit rs.Fields("imagepath").Value = DstFile rs.Update rs.MoveNext Wend rs.Close Set rs = Nothing

في حدث عند الفتح ضع الكود التالي مع اضافة مسار كل ملف داخل الكود Dim strFilename As String: strFilename = "ضع هنا مسار الملف" Dim strTextLine As String Dim iFile As Integer: iFile = FreeFile Open strFilename For Input As #iFile Do Until EOF(1) Line Input #1, strTextLine [ComoboBox1].AddItem strTextLine Loop Close #iFile

تفضل List.zip

تفضل الكود و التعديل On Error Resume Next Dim MyFile, DstFile As String Dim Syso As Object Dim db As DAO.Database Dim rs As DAO.Recordset '==================================== Set rs = CurrentDb.OpenRecordset("SELECT * FROM Table1 where nategacode=2") rs.MoveFirst While (Not rs.EOF) MyFile = CurrentProject.Path & "\savefrom\" & Right$(rs.Fields("imagepath"), Len(rs.Fields("imagepath")) - InStrRev(rs.Fields("imagepath"), "\")) DstFile = CurrentProject.Path & "\saveto\" & Right$(rs.Fields("imagepath"), Len(rs.Fields("imagepath")) - InStrRev(rs.Fields("imagepath"), "\")) DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing Kill MyFile rs.Edit rs.Fields("imagepath").Value = DstFile rs.Update rs.MoveNext Wend rs.Close Set rs = Nothing MsgBox "تم نقل الصور بنجاح", vbInformation + vbMsgBoxRight, "تأكيد" DoCmd.Requery فصل صور الطلاب.zip

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

جميع ما تريد من الأكواد لعمل هذه المهام موجود داخل البرنامج لكن تفضل هذا يعرض المجلد Function BrowseForFolder(Optional OpenAt As Variant) As Variant Dim ShellApp As Object Set ShellApp = CreateObject("Shell.Application"). _ BrowseForFolder(0, "Please choose a folder", 0, OpenAt) On Error Resume Next BrowseForFolder = ShellApp.self.Path On Error GoTo 0 Set ShellApp = Nothing Select Case Mid(BrowseForFolder, 2, 1) Case Is = ":" If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid Case Is = "\" If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid Case Else GoTo Invalid End Select Exit Function Invalid: BrowseForFolder = False End Function الاستدعاء و حفظ المسار داخل الجدول في حقل النموذج [TextBox1] = BrowseForFolder("c:\\")

انت تريد الاستدامة لقاعدة البيانات ارفاق المستندات داخل القاعدة يجعل القاعدة عرضة للتلف اتوقع انك فتحت الملف الخطأ قم بتحميل أخر تعديل ستجدل كل ما تحتاجه اضافة و حذف و عرض الملفات جرب التعديل المرفق لعرض الملف اضغط على اسم الملف في القائمة و على ازرار فتح الملف Microsoft Access قاعدة بيانات جديد.zip

اذا طريقة المهندس قاسم هي الحل النهائي

غير واضح مقصدك انت تحدد الكل لكي تطبع الكل / لكن في نفس الوقت لا تريد طباعة الكل

استخدم الكود التالي و هو نفسه السابق مع تعديلات بسيطه تختار قاعدة البيانات المطلوب اغلاقها Dim DB As Object Dim Addfile As Object Set Addfile = Application.FileDialog(3) With Addfile .AllowMultiSelect = False .InitialFileName = "" .Filters.Clear .Filters.Add "Access From 2007", "*.accdb" .Filters.Add "Access From 2002 T0 2003", "*.mdb" If .Show = True Then Set DB = GetObject(Trim(.SelectedItems(1))) DB.Application.Quit Else Exit Sub End If End With و بما ان مسار قاعدة البيانات محدد فأنصحك ان تستخدم التالي Dim DB As Object Set DB = GetObject("ضع مسار قاعدة البيانات هنا فقط") DB.Application.Quit هذه الجملة تعطيك مسار قاعدة البيانات الحالية CurrentProject.Path اذا لم ينج معك الأمر ارفق نسخة من برنامجك

العفو و تحت امرك في اي وقت كلنا اخوان

ما يحتاج و لو حبيت تعلن عنه في النهاية هو String القي نظرة على المثال المرفق هذاDatabase2.mdb

انسخ و الصقها مثل ماهي بدون تغيير Dim DB As Object dbPath = CurrentProject.FullName Set DB = GetObject(dbPath) DB.Application.Quit من هذا السطر تتحكم في المسار و حاليا المسار هو قاعدة البيانات التي تعمل عليها dbPath = CurrentProject.FullName تفضل هذا المثال Database2.mdb

تفضل هذا المثال Database2.mdb