البحث في الموقع

أخواني وأساتذتي ومعلمينا ( دون استثناء ) أشارككم في هذا الموضوع أداة بسيطة وفعالة قمت بتطويرها لأغراض إنشاء واستعادة نسخ احتياطية من قواعد بيانات اكسيس . ✔️ الهدف الأساسي من الأداة هو توفير طريقة مرنة وآمنة لأخذ نسخ احتياطية من الجداول المهمة بشكل دوري أو عند الحاجة ، وتسهيل استعادتها لاحقاً بنفس البنية والبيانات . صورة من واجهة الأداة :- الواضح من الواجهة ، أن الأداة ستمكنك من :- أولاً :- إنشاء نسخة احتياطية ضمن الإعدادات التي تحددها في زر "خيارات الحفظ" . عند النقر عليه ستجد هذه الإعدادات في الصورة .. مسار الحفظ للنسخ الإحتياطية سيكون فقط في المجلد Backup في المجلد الرئيسي Data الموجود بجانب قاعدة البيانات . نوع الملحق سيكون MDB و DAT . وهما النوعين الأكثر شمولاً واستخداماً في جميع الأفكار التي لها نفس الوظيفة . عدد النسخ التي ستحتفظ بها هو فقط ما تحدده . وسيتم حذف النسخ الأقدم تباعاً . بإمكانك تحديد كلمة مرور لحماية قاعدة بيانات الجداول . ولا ننصح بتغييرها لكل نسخة كي لا تتوه وتفقد بياناتك . إمكانية النسخ التلقائي حسب عدد الأيام أو الساعات الي تريد أخذ نسخة تلقائية فيه . ثانياً :- إنشاء نسخة احتياطية لجداول تقوم بتحديدها - ولك حرية اختيار الجداول في كل نسخة - حيث أنها لن تؤثر على سير عملية الإسترجاع لاحقاً . انظر الصورة للتوضيح :- على اليمين تظهر أسماء الجداول في القاعدة الحالية ( مرتبطة أو محلية ) . ولك الحرية باختيار جداول محددة بالنقر المزدوج على الجدول ، أو تحديد الكل / إلغاء الكل . حسب حاجتك . ثالثاً :- الأزرار كما هي في صورة واجهة الأداة ، تشير إلى :- زر "حفظ نسخة إحتياطية جديدة" :- لإنشاء نسخة إحتياطية حسب الإعدادات اتي تم تحديدها . زر "تحديث بيانات النُسخ الإحتياطية" :- لإعادة ترتيب السجلات في الجدول حسب النسخ الموجودة في مجلد انسخ الإحتياطي . زرا "نُسخ محددة" و "كافة النُسخ" :- لحذف محدد أو لجميع النسخ الإحتياطية . زر "إنشاء" في قسم "نسخة خاصة" :- مخصص لإنشاء نسخة خاصة في مكان يقوم المستخدم بتحديده وليس ضمن المسار المحدد في الإعدادات ، وبإسم متغير كيفما يريد . زر "استرجاع" في قسم "نسخة خاصة" :- مخصص لإسترجاع نسخة يقوم المستخدم بتحديدها بشكل يدوي من خلال مربع حوار اختيار ملف . زر "استرجاع" في قسم "استرجاع النسخة رقم" :- مخصص لاختيار نسخة محددة برقمها . حيث تظهر النسخ التي تم أخذها إحتياطياً ، في أعلى جزء النموذج والتنقل بينها من خلال الزرين < > . رابعاً :- في هذا الإصدار ( V1.0 ) من الأداة على عدم الإعتماد على أي مكتبات خارجية أو من مكتبات أكسيس . حيث تمت التجربة على إصدارات اكسيس ( 2010 فما فوق ) . Backup 2025 - V1.0.accdb.zip :- دائماً يسعدني إبدائكم الرأي والملاحظات حول الأخطاء والمشاكل التي يمكن مواجهتها في أي مشروع يتم تأسيسه في آكسيس أو غيره من لغات البرمجة . أولاً تأكد من وجود جدولي الأداة ( USysMyCopies و USysOptCopies ) عند نسخها الى مشروعك . مع العلم أنها مخفية كجداول نظام ، ويمكنك إظهارها كما في الصورة التالية :- ثانياً ، قم بالدخول الى خيارات الحفظ ، والنقر على زر "انقر لضبط مسار مجلد الحفظ بشكل آلي" لضبط وتحديد مسار مجلد الحفظ الرئيسي . فقط لأول مرة .

السلام عليكم هذا كود من أعمال الأستاذ الكبير عبدالله باقشير حفظه الله ورعاه أحببت أن اطرحه في موضوع كي يستفيد منه الجميع في أول الكود تحط الشروط المراده * بداية البيانات بدون رؤس الاعمدة * الاعمدة المراد عمل عليها جمع بالامكان تحديد الاعمده اما بشكل فردي وهو "$A$1,$C$1,$F$1" أو بشكل مدى من الى هكذا "$A$1:$G$1" أو بشكل مدى متقطع هكذا "$A$1,$C$1,$E$1:$H$1,$i$1:$K$1" ******************************************************************** الكود ينشاء صف وبه الجمع وبعد الانتهاء من وضع معاينة الطباعه يحذف الصف ******************************************************************** الكود يوضع في مودويل '**************************************** ' بداية البيانات بدون رؤس الأعمدة Private Const Row_Star As Integer = 2 '**************************************** 'الاعمدة المراد جمع قيمها في نهاية فواصل الصفحات Private Const C_N As String = "$A$1,$C$1,$D$1:$F$1" Sub Ali_Sum_Page() Dim Ar() As Integer Dim Rng As Range, Cc As Range Dim C As Range, Cr As Range Dim iCont As Integer Dim i As Integer, ii As Integer Dim r1 As Integer, r2 As Integer Dim Cv As Integer, L_C As Integer ''''''''''''''''''' For Each Cc In Range(C_N) L_C = Cc.Column Next With Cells.Worksheet With .PageSetup .PrintTitleRows = "$1:$1" .PrintTitleColumns = "" End With .ResetAllPageBreaks .Range("A65536").Select .Cells(Row_Star, "A").Select iCont = .HPageBreaks.Count If iCont = 0 Then Exit Sub ''''''''''''''''''''''' ReDim Ar(1 To iCont) For i = 1 To .HPageBreaks.Count ii = .HPageBreaks(i).Location.row Ar(i) = ii Next ''''''''''''''''''''''' r1 = Row_Star For i = 1 To iCont ii = Ar(i) - 1 With .Range("A" & ii).Resize(1, L_C) .EntireRow.Insert With .Offset(-1, 0) L_r = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row If Rng Is Nothing Then Set Rng = .Cells Else Set Rng = Union(Rng, .Cells) r2 = ii - 1 For Each C In Range(C_N) Cv = C.Column .Cells(1, Cv) = WorksheetFunction.Sum(Range(Cells(r1, Cv), Cells(r2, Cv))) Next r1 = r2 + 2 End With End With Next For Each Cr In Range(C_N) Cv = Cr.Column With .Cells(L_r, Cv) .Value = WorksheetFunction.Sum(Range(Cells(r1, Cv), Cells(L_r - 1, Cv))) .Interior.ColorIndex = 6 End With Next End With '''''''''''''''''''''' If Not Rng Is Nothing Then With Rng .Interior.ColorIndex = 6 .Worksheet.PrintPreview Range("A" & L_r).EntireRow.Delete .EntireRow.Delete End With End If ''''''''''''''''''''''' Erase Ar Set Rng = Nothing: Set Cc = Nothing Set Cr = Nothing: Set C = Nothing End Sub والسلام عليكم