أبو آدم

أبا ياسين سؤلنا فأجبنا ... طلب منا فوفينا ما ادركنا و عملنا و الامر الآن بين يدي من يريد ان يستخدم الافكار ، فليفعل ما يشاء و كل يرى الأمور كما يشاء ليحقق حاجاته و نحن في العون ما استطعنا ، و الله من وراء القصد ...

السلام عليكم أخي ابا زاهر تفضل كافة الطلبات اصبحت جاهزة نسخ احتياطي - تصفية النسخ الاحتياطية ( بين اعادة التسمية و الحذف ) - و اخيراً ... الاسترداد و التنقل بين النسخ أو القاعدة الاصلية دعوة بظهر الغيب ، تنفع أخاك .... و الله من وراء القصد .... .... NA_B&R Final.rar و ندعو لابنك ان يفرج الله عنك و عنه اللهم رب الناس، أذهب الباس، واشفه وأنت الشافي؛ لا شفاء إلا شفاؤك، شفاء لا يغادر سقماً اللهم رب الناس، أذهب الباس، واشفه وأنت الشافي؛ لا شفاء إلا شفاؤك، شفاء لا يغادر سقماً اللهم رب الناس، أذهب الباس، واشفه وأنت الشافي؛ لا شفاء إلا شفاؤك، شفاء لا يغادر سقماً

السلام عليكم أخي ابا زاهر هل تريد أن ارفق لك التطبيق معدلا ....

أحسن الله اليك أخي وائل

السلام عليكم أخي ابا زاهر ليس لديه طلبات خاصة ... المهم تطبيق الفكرة بشكل عام ، و اذا ظهرت امور اخرى نعالجها باذن الله الكود المرفق كما هو خلف حدث عند النقر لزر أمر الاسترداد في التطبيق لديك Dim fdg As FileDialog, vrtSelectedItem As Variant Dim strSelectedFile As String Set fdg = Application.FileDialog(msoFileDialogFilePicker) With fdg .AllowMultiSelect = False .InitialView = msoFileDialogViewDetails .InitialFileName = Application.CurrentProject.Path & "\Backup" .Title = "Please select BackUp File" .Filters.Clear .Filters.Add "Access Databases", "*.MDB,*.MDE,*.ACCDB,*.ACCDE" .Filters.Add "All Files", "*.*" .ButtonName = "Restore" If .Show = -1 Then For Each vrtSelectedItem In .SelectedItems strSelectedFile = vrtSelectedItem Next vrtSelectedItem Else MsgBox "You did not select a BackUp File." & _ vbNewLine & "The Restore process was stopped ... ", vbCritical, "Operation Stopped" Exit Sub End If End With Set fd = Nothing relinkTables (strSelectedFile) ثم انسخ الروتين التالي في محرر اكواد النموذج Public Sub relinkTables(NewPathname As String) Dim Dbs As Database Dim tdf As TableDef Dim Tdfs As TableDefs Set Dbs = CurrentDb Set Tdfs = Dbs.TableDefs 'Loop through the tables collection For Each tdf In Tdfs If tdf.SourceTableName <> "" Then 'If the table source is other than a base table tdf.Connect = ";DATABASE=" & NewPathname 'Set the new source tdf.RefreshLink 'Refresh the link End If Next 'Goto next table End Sub جرب و وافني بالنتيجة .... كل مرة تختار فيها نسخة للاسترداد و تتم العملية اذهب الى الجداول لترى ان مصدرها هو النسخة التى اخترتها .......

السلام عليكم هل يمكن ان توضح لي مفهومك ( او حاجاتك .. ) بخصوص الاسترداد فالصور عديدة و الحاجات مختلفة شكرا ....

المرفق حسب آخر التعديلات بعد فك الضغط افتح قاعدة البيانات وقم باعادة الربط للجداول قبل فتح قاعدة البيانات انظر محتويات مجلد النسخ الاحتياطية ( حتى تلاحظ الفرق لاحقا ) في النموذج زر امر جديد ... اضغط عليه و وافني بالنتيجة .... NA_B&R.rar

صباح الخير أخي أبا زاهر عملية تصفية الملفات في مجلد النسخ الاحتياطية برمجيا مسألة متاحة ، وقمت بتجهيز الكود التالي ليقوم بفحص الملفات و التعرف عليها حسب التسمية التي فرضناها للنسخ الاحتياطية ، وليس حسب تاريخ انشاء او تعديل الملفات ، و ذلك تحسبا لوجود ملفات اخرى في المجلد ، و من باب الدقة و الحصر. و في النسخة الموجودة لدي ( من قاعدة بياناتك ) قمت بانشاء زر أمر للتعامل من الروتين عند النقر Dim strFldr As String Dim strFile As String Dim FileToGet As String strFldr = CurrentProject.Path & "\BackUp" strFile = Dir(strFldr & "\Data*.*") Do While Len(strFile) > 0 FileToGet = Left(strFile, Len(strFile) - 6) If Len(FileToGet) = 12 Then ' only check files with name of correct length If FileToGet <= CStr("Data" & Format(Date - 1, "yyyymmdd")) & ".accdb" Then ' only check files with name of correct Format 'Renames Name strFldr & "\" & strFile As strFldr & "\" & "OLD .. " & strFile 'Deletes 'Kill strFldr & "\" & strFile Else ' do Nothing End If Else 'Ignore file End If strFile = Dir Loop وانت هنا بالخيار بين اعادة تسمية الملفات القديمة و ابقائها أو حذفها ، هنا فعلت كود اعادة التسمية ، و يمكنك ايقاف كود اعادة التسمية و تفعيل كود الحذف Kill strFldr & "\" & strFile و هنا اخترت اعادة تسمية الملف بعد يوم واحد ، بينما يمكنك تعديل المدة و اختيار ما تشاء و للحديث بقية ...

صباح الخير طبعا نحن هنا قمنا بنسخ القاعدة الى مجلد النسخ الاحتياطية ، وقمنا بتمييز اسم القاعدة بالحاق حرف X فقط ، دون تمييزها بتاريخ ، وهذا تبسيط للموضوع و الكود اما في الواقع لا بد من تمييز الاسم بالحاق نمط تاريخ و / أو وقت عند اللزوم ، فاذا كانت هناك اجراءات برمجية او لزوم لاخذ اكثر من نسخة احتياطية في اليوم يلزم الحاق الوقت مع التاريخ و الا فالتاريخ كافي ، وهو لازم للفكرة الاخيرة التي تتحدث عنها و هي تراكم النسخ الاحتياطية. وبذلك يصبح تعريف اسم النسخة الاحتياطية strBackupFile = "Data" & Format(Now, "yyyymmdd") & ".accdb" بدلا عن strBackupFile = "DataX.accdb" و قبل الحديث عن : ما هو مفهوم الاسترداد لديك ؟ لا بد من تصفية و صيانة النسخ الاحتياطية تمهيدا لاسترداد احداها ، و ساجهز لك الكود مع شرح بسيط و للحديث بقية ...

تفضل ... قمت بتغيير الاسماء العربية للملفات B&R.rar

أضف المرجع 'Microsoft Scripting Runtime' قم بتغيير اسم قاعدة البيانات و حدد المسارات

أخي ابا زاهر رغم تعدد الاسئلة ... ساجيب عليك لنأخذ الموضوع ببساطة خلف حدث عند النقر ضع هذه التعريفات Dim strSourcePath As String Dim strBackupPath As String Dim strBackupFile As String Dim fso As FileSystemObject ثم ننتقل للتحديدات : مصدر النسخ ( موقع القاعدة الحالية و اسم القاعدة ) او مسار القاعدة على D كاملا مع اسم القاعدة strSourcePath = CurrentProject.Path & "\Data.accdb" مكان تخزين النسخة الاحتياطية ( موقع القاعدة الحالية و اسم المجلد ) او مسار القاعدة على D كاملا مع اسم المجلد strBackupPath = CurrentProject.Path & "\Backup" & "\" اسم قاعدة النسخة الاحتياطية ( مع امتداد الملف ) strBackupFile = "DataX.accdb" ثم نقوم بعملية النسخ Set fso = New FileSystemObject fso.CopyFile strSourcePath, strBackupPath & strBackupFile, True Set fso = Nothing ثم نشعر المستخدم بنجاح و انتهاء عملية النسخ MsgBox "Backup Complete. Backup file is located at: " & Chr(13) & strBackupFileName, vbInformation, " BackUp BackEnd" ليصبح الكود Dim strSourcePath As String Dim strBackupPath As String Dim strBackupFile As String Dim fso As FileSystemObject strSourcePath = CurrentProject.Path & "\Data.accdb" strBackupPath = CurrentProject.Path & "\Backup" & "\" strBackupFile = "DataX.accdb" Set fso = New FileSystemObject fso.CopyFile strSourcePath, strBackupPath & strBackupFile, True Set fso = Nothing MsgBox "Backup Complete. Backup file is located at: " & Chr(13) & strBackupFileName, vbInformation, " BackUp BackEnd" جرب طبق ونتابع ... بعد التطبيق أرسل لي الكود الذي نفذت به العملية على قاعدتك و الذي يحمل الاسماء و المسارات .... لنستكمل بقية الطلبات و الله من وراء القصد

أو ممكن ان يكون الشرط كما يلي If Weekday(Me.txtDate) = 6 Then Cancel = (MsgBox("The Date is on a " & _ Format(Me.txtDate, "dddd") & vbCrLf & vbCrLf & _ "Do you want to keep this date?" _ , vbYesNo + vbQuestion) = vbNo) If Cancel Then Me.txtDate.ForeColor = vbRed End If

لم انظر الى التطبيق الذي ارفقته بمشاركتك و لكن الكود يكون في حدث قبل التحديث للحقل الذي يتم ادخال التاريخ به ، و هنا أسميته txtDate

تفضل Private Sub txtDate_BeforeUpdate(Cancel As Integer) If Weekday(Me.txtDate) = vbFriday Then Cancel = (MsgBox("The Date is on a " & _ Format(Me.txtDate, "dddd") & vbCrLf & vbCrLf & _ "Do you want to keep this date?" _ , vbYesNo + vbQuestion) = vbNo) If Cancel Then Me.txtDate.ForeColor = vbRed End If End Sub

شكرا و أحسن الله اليك كما أحسنت الي

شكرا و حياك الله بيننا

قم بتحديد عرض الحقول في حدث عند التحميل

عندما تسجل المستعير في جدول البيانات يأخذ رقما تلقائيا هذا الرقم جعلته في علاقات جداولك مرتبطا برقم المستعير في جدول الاعارة و بذلك يصبح تغيير الرقم غير متاح بالطريقة التي تفكر بها

كود للدوران ضمن مجموعة خلايا في الاكسيل وتثبيت منضومة ارقام

شكرا و أحسن الله اليك

نريد ضبط منع التكرار في نموذج ... جربت أفكار كثيرة و لكنها تعتمد على تحليل وتصميم عمليات و نماذج الادخال

لنلق نظرة على مثال بسيط جدًا لإنشاء Class Alt+F11 Insert Module Class Module يظهر لنا محرر Visual Basic قبل البدء بكتابة الكود يفضل ان نثبت إسم للوحدة النمطية و ليكن clsCustomer في المحرر نكتب ' Class name: clsCustomer Public Name As String قم بحفظ الاجراءات و اخرج من الوحدة النمطية و لنقم مثلاً بانشاء نموذج جديد و نفتح عرض التصميم ، و في محرر Visual Basic نضع الروتين التالي Private Sub sfPrint() End Sub حيث نقوم بتعريف اسم زيون جديد حسب المعرف في clsCustomer باستخدام العبارة ، و هي اساسية لتعريف الزبون الجديد Dim oCustomer As New clsCustomer ثم نستخدم خاصية الاسم name. لهذا الزبون الجديد و نسند له القيمة ' Set the customer name oCustomer.Name = "Nart Lebzo" ثم نحدد الاجراء المراد تطبيقه ' MsgBox the name MsgBox oCustomer.Name و بذلك يصبح الكود كما يلي Private Sub sfPrint() ' Create the object from the class module Dim oCustomer As New clsCustomer ' Set the customer name oCustomer.Name = "Nart Lebzo" ' MsgBox the name MsgBox oCustomer.Name End Sub ثم نقوم ( مثلا ) بانشاء زر أمر نضع خلف حدث النقر الكود التالي لاستدعاء الروتين الذي يطبق clsCustomer Private Sub Command0_Click() Call sfPrint End Sub و للحديث بقية ......

يتم تعريف كل كائن في Visual Basic بواسطة Class و الذي يحوي و يفصل المتغيرات والخصائص والإجراءات والأحداث الخاصة بالكائن ، و تصبح هذه الكائنات ممثلة ل Class ؛ و بذلك يمكنك إنشاء العديد من الكائنات التي تحتاج إليها بمجرد تعريف و إنشاء Class. Class ، تحدد و تعرف الصفات المميزة للكائنات الخاصة بنا . و للتعامل مع الكائن و مميزاته و اجزائه ، لا بد من إنشائه بموجب Class و هنا نستخدم Class لإنشاء تعريف لكائن مخصص . يصبح الاسم الذي قمت بحفظ Class به هو اسم الكائن المخصص الخاص بك. تصبح الإجراءات Sub Sub و Function التي تحددها داخل Class أساليب مخصصة للكائن. تصبح إجراءات الملكية العامة Let و Property Get و Set Property خصائص الكائن. و للحديث بقية ....

اطلعت على المرفق حسب المرفق رقم المستعير عندك مرتبط مع الترقيم التلقائي للمستعير من جدول البيانات