نجوم المشاركات

وعليكم السلام ورحمة الله تعالى وبركاته يصعب الاشتغال على ملف فارغ لا يتضمن اي بيانات حاول اخي الكريم تصمييم الفورم الخاص بك اولا مع اظافة بعض البيانات الوهمية على الملف 1) مكان اظهار بيانات البحث هل على ليست بوكس او عناصر التيكست بوكس مثلا.......... 2) توضيح البيانات المرغوب طباعتها مع تحديد النطاق لا يمكن الاشتغال على التخمين

تحويل الوقت والتاريخ المحلى الي التوقيت عن التوقيت العالمي الموحد (UTC) عرض تاريخ و اوقات دول او مدن مختلفة في نفس الوقت بناء على فرق الوقت بينعم ولين التوقيت العالمي الموحد جدول tblTimeZones والذى يتكون من الحقول ShowInForm : اختيار البلدان للعرض في النموذج CountryName : اسماء المدن و البلدان TimeDifference : فرق التوقيت عن التوقيت العالمي الموحد (UTC) الفارق الزمني (بالساعات، مع إشارة "+" أو "-") DaylightSavingTime : التوقيت الصيفي اولا اكواد الوحدة النمطية Option Compare Database Option Explicit #If VBA7 Then Private Declare PtrSafe Function GetSystemTimeAPI Lib "kernel32" Alias "GetSystemTime" (lpSystemTime As SYSTEMTIME) As Long #Else Private Declare Function GetSystemTimeAPI Lib "kernel32" Alias "GetSystemTime" (lpSystemTime As SYSTEMTIME) As Long #End If Private Type SYSTEMTIME ' Structure for SYSTEMTIME wYear As Integer wMonth As Integer wDayOfWeek As Integer wDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As Integer End Type Public Function GetUTC() As Date ' Function to get the current UTC time Dim utctime As Date Dim sysTime As SYSTEMTIME Call GetSystemTime(sysTime) utctime = DateSerial(sysTime.wYear, sysTime.wMonth, sysTime.wDay) + TimeSerial(sysTime.wHour, sysTime.wMinute, sysTime.wSecond) GetUTC = utctime End Function Private Function GetSystemTime(lpSystemTime As SYSTEMTIME) As Long ' Declaration to get system time GetSystemTime = GetSystemTimeAPI(lpSystemTime) End Function هذه الدوال توفر الحصول على الوقت الحالي بالتوقيت العالمي (UTC) SYSTEMTIME هو هيكل يستخدم لتخزين التاريخ والوقت GetSystemTimeAPI هى احد دوال API لـ Windows وظيفتها الحصول على الوقت العالمي (UTC) GetUTC هى دالة تستدعي الدالة GetSystemTimeAPI للحصول على الوقت الحالي بالتوقيت العالمي (UTC) ويتم اعادته كقيمة تاريخ/وقت طيب بعد ذلك الاكواد داخل النموذج النموذج يعرض توقيتات متعددة لدول مختلفة بناء على الاعدادات الموجودة في الجدول tblTimeZone Const FormatDisplayDate As String = "dd/mm/yyyy" Const FormatDisplayTime As String = "hh:mm:ss AM/PM" Const CountDisplayCountry As Integer = 5 Private Sub Form_Load() ' Set the form's timer interval to update every 1 second Me.TimerInterval = 1000 ' Call the function to update times and dates UpdateTimes End Sub Private Sub Form_Timer() ' Call the function to update times and dates when the timer event occurs UpdateTimes End Sub Private Sub UpdateTimes() On Error GoTo ErrorHandler Dim rs As DAO.Recordset Dim utctime As Date Dim i As Integer ' Get the current UTC time utctime = GetUTC() ' Debug.Print "UTC Time: "; utctime ' Open the recordset to fetch data from the tblTimeZones table Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblTimeZones WHERE ShowInForm = True") ' Check if recordset is not empty If Not rs.EOF Then rs.MoveFirst i = 1 ' Loop through each record in the recordset and update the form fields Do While Not rs.EOF And i <= CountDisplayCountry ' Limiting to 5 fields as per your requirement ' Assign values to form fields for each country If FieldExists("txtCountry" & i) Then Me("txtCountry" & i) = rs!CountryName Me("txtTimeDifference" & i) = rs!TimeDifference Me("chkDaylightSavingTime" & i) = rs!DaylightSavingTime ' Adjust time and date based on daylight saving time Dim localTime As Date If rs!DaylightSavingTime Then localTime = DateAdd("h", rs!TimeDifference + 1, utctime) Else localTime = DateAdd("h", rs!TimeDifference, utctime) End If Me("txtTime" & i) = Format(localTime, FormatDisplayTime) Me("txtDate" & i) = Format(localTime, FormatDisplayDate) End If rs.MoveNext i = i + 1 Loop Else ' Display a message if no records found for countries to display 'MsgBox "No countries found to display in the form.", vbExclamation, "No Records" Exit Sub End If ' Close the recordset rs.Close Set rs = Nothing Exit Sub ExitHandler: Exit Sub ErrorHandler: Select Case Err.Number Case 2465 ' Can't find the Object Resume ExitHandler Case Else MsgBox "Error in UpdateTimes: " & Err.Number & vbCrLf & Err.Description, vbExclamation 'Debug.Print Err.Number & " " & Err.Description Resume ExitHandler End Select End Sub Private Function FieldExists(fieldName As String) As Boolean ' Check if a field exists in the form On Error Resume Next FieldExists = (Me(fieldName).Name <> "") On Error GoTo 0 End Function الاعلان عن الثوابت Const FormatDisplayDate : للتحكم فى شكل تسيق التاريخ الذى سوف يتم عرضه Const FormatDisplayTime : للتحكم فى شكل تسيق الوقت الذى سوف يتم عرضه Const CountDisplayCountry : تحديد عدد الدول التى نريد عرض اوقاتها فى النموذج والذى على اساسة ايضا عدد العناصر فى النموذج لهذه البيانات Form_Load: عند تحميل النموذج، يتم تعيين الفاصل الزمني للمؤقت إلى ثانية واحدة ثم يتم استدعاء الدالة UpdateTimes Form_Timer: يتم استدعاء الدالة UpdateTimes كل ثانية لتحديث التوقيتات UpdateTimes وظيفة هذه الدالة هي الحصول على الوقت الحالي بالتوقيت العالمي (UTC) باستخدام الدالة GetUTC فتح مجموعة السجلات من الجدول tblTimeZones لجلب البيانات بناؤ على شرط أن يكون الحقل ShowInForm مضبوطًا على True في حلقة تكرارية يتم تحديث البيانات في العناصر في النموذج بناء على بيانات السجلات مع الأخذ بعين الاعتبار التوقيت الصيفي إذا كان مفعلاً يتم التعامل مع الأخطاء باستخدام كتلة ErrorHandler لضمان عدم تعطل البرنامج بسبب الأخطاء FieldExists: دالة للتحقق مما إذا كان عنصر معين موجودا في النموذج جدول tblTimeZones يحتوي على بيانات عن بلدان مختلفة بما في ذلك فرق التوقيت والتوقيت الصيفي وما إذا كانت البيانات يجب عرضها حيث يتم عرض البلدان المحددة فقط من خلال (ShowInForm = True) في النموذج العناصر فى النموذج كالاتى txtCountry1, txtCountry2, txtCountry3, txtCountry4, txtCountry5 المفروض يتم جلب اسماء البلدان من الجدول هنا ----------------------------------- txtTime1, txtTime2, txtTime3, txtTime4, txtTime5 المفروض يتم عرض التوقيت المحلى لكل بلد هنا ----------------------------------- txtTimeDifference1, txtTimeDifference2, txtTimeDifference3, txtTimeDifference4, txtTimeDifference5 المفروض يتم جلب الفرق في التوقيت لكل بلد هنا ----------------------------------- chkDaylightSavingTime1, chkDaylightSavingTime2, chkDaylightSavingTime3, chkDaylightSavingTime4, chkDaylightSavingTime5 المفروض يتم عرض ان كان التوقيت الصيفي مفعلا ام لا هنا ----------------------------------- txtDate1, txtDate2, txtDate3, txtDate4, txtDate5 المفروض يتم عرض التاريخ طبقا للتوقيت المحلى لكل بلد هنا ----------------------------------- المفروض كل ذلك يحدث من خلال الكود بمجرد فتح النموذج بطريقة الية والشرط طبعا هو جلب البيانات بناء على البلدان المختارة عرض بيناتها من خلال اختيارها من الحقل ShowInForm واخيرا المرفقات المرفق الاول وهو الاساس والذى تم استعراض الافكار والاكواد السابقة طبقا له المرفق الثانى فقط تم اضافة عدد نماذج لساعات على ان تكون نماذج فرعية TimeZones.zip TimeZones UP 2.zip

هذا كان لطلب سابق لأحد الاخوة لما يكون الحقل خالي يعتبر قيمته عند الجمع صفر (لأنه عند جمع الحقول لا يجمع حقل خالي يعطي (Erorr)) . أما لطلبك نضع تحت الحقل الشرط أكبر من صفر (0<) أو لا يساوي صفر (0<>)

تفضل استاذ @walid7799 توني مسوي مثال مثل طلبك . تفضل المرفق . DDTestSunNull.rar

اعمل استعلام جديد مبني علي الجدول بتاعك وتعالي عالحقل اللي حضرتك عايز تعرض فيه القيم الأكبر من صفر وقوله فى المعايير ( criteria ) > 0

الله يبارك فيك دنيا وآخرة بحق هذه الأيام المباركة وكل عام وأنت طيب وبخير

تفضل استاذ @2saad حسب مافهمت تفضل المرفق . DDTestSunNull.rar

انظر الصور

السلام عليكم 🙂 بالاضافة الى كود اخوي ابو جودي ، اليك طريقة اخرى ، استعلام فرعي، والمفروض يكون اسرع في التنفيذ. في استعلام مصدر بيانات نموذجك، اعمل حقل جديد، ولنسميه A2، ويحتوي على هذا الكود: A2: (Select Sum([m_price]) From Qry_UNION_MOKHTABER Where date_R between DateSerial(Year(Date()), Month(Date())-1,27)) And DateSerial(Year(Date()),Month(Date()),26) يعني يكون الاستعلام هكذا: جعفر

كل عام وأنتم بخير احرص تضيف الكود في موديول الصفحة نفسها أفضل من إضافته في موديول عام، أو أن تختار الصفحة الهدف أولا قبل تشغيل الكود. عدل في السطر بأن تضغ بعد علامة = رقم آخر سطر في الصفحة بدلا من الأمر مثلا: lRow = 300

من رأس الهرم في مشروعك؟ اعني عند الادخال والاخراج هل هناك قيمة او معلومة اساسية ينبني عليها مذكرة الادخال و مذكرة الاخراج هل هو العميل ام الصنف ؟ هل العميل اساسي ؟ او هو من ضمن بيانات الفاتورة ؟ استفساري هذا ينبني عليه عمليات التصفية في التقارير مستقبلا .. ايضا ينبني عليه هل رأس الفاتورة اساسي ام لا فضلا اجب بكل دقة حسب العمل القائم الآن

وعليكم السلام ورحمة الله تعالى وبركاته المفروض اخي @Alaa Ammar New ورقة الاشطة خاصة بفلترة البيانات بين تاريخين يتم تحديدهم مسبقا في الخلية D2 و F2 بمعنى انت من تحدد البيانات الظاهرة عليها .في حالة الرغبة بجلب جميع البيانات يمكنك فقط تحديد اول واخر تاريخ لديك على Sheet1 يمكنك اظافة الكود التالي في حدث Sheet1 ليتم تحديث التسلسل تلقائيا . Private Sub Worksheet_Change(ByVal Target As Range) Dim sht As Worksheet: Set sht = Sheets("Sheet1") If Target.Column = 1 Then Application.ScreenUpdating = False Application.EnableEvents = False sht.Range("A9:A" & sht.Rows.Count).ClearContents sht.[A9].Value = 1 With sht.Range("A9:A" & sht.Cells(sht.Rows.Count, "C").End(xlUp).Row) .Formula = "=Row() - 8" .Value = .Value End With Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub Dim desWS As Worksheet: Set desWS = Sheets("Sheet1") Dim dest As Worksheet: Set dest = printing Application.ScreenUpdating = False If Sheets("Sheet1").TextBox1.Text = "" Then: MsgBox "يرجى اظافة معيار الفلترة": Exit Sub rng = Application.WorksheetFunction.Subtotal(3, desWS.Range("L9:L10000")) If rng = 0 Then: MsgBox "لا توجد بيانات للحفظ", _ vbInformation, "تم إلغاء الإجراء": Exit Sub dest.Visible = xlSheetVisible Set a = desWS.Range("A7", desWS.Range("A" & desWS.Rows.Count).End(xlUp)) For r = 1 To 12 Set a = Union(a, Intersect(a.EntireRow, a.Columns(r))) Next r Msg = MsgBox("؟" & " " & "PDF " & ":" & " تصدير التقرير بصيغة", vbYesNo, dest.Name) If Msg <> vbYes Then Exit Sub dest.Range("A2:L" & dest.Rows.Count).Clear a.Copy Destination:=dest.Range("A6") dest.Range("a8").Value = 1 With dest.Range("a8:a" & dest.Cells(dest.Rows.Count, "B").End(xlUp).Row) .Formula = "=Row() - 7" .Value = .Value End With 'حفظ PDF Save_As_PDF2 On Error Resume Next desWS.AutoFilter = False Sheets("Sheet1").TextBox1.Text = "" Application.ScreenUpdating = True 2024 final.xlsm

وعليكم السلام ورحمة الله تعالى وبركاته تفضل اخي ضع الكود التالي في Module Function arr(a, b) maxtab1 = UBound(a) Dim tmp(): ReDim tmp(1 To UBound(a) + UBound(b), 1 To UBound(a, 2)) For i = LBound(a) To UBound(a) For c = 1 To UBound(a, 2): tmp(i, c) = a(i, c): Next Next i For i = 1 To UBound(b) For c = 1 To UBound(b, 2): tmp(maxtab1 + i, c) = b(i, c): Next Next i arr = tmp End Function وفي داخل اليوزرفورم Dim rng(), Cnt, Width, OneRng, ColVisu '09/06/2024 by:MOHAMEED HICHAM www.officena.net "منتدى الاكسيل" ' Private Sub UserForm_Initialize() Dim Cpt, F Cpt = [Data]: F = [Data1]: rng = arr(Cpt, F) 'Merge table data For i = LBound(rng) To UBound(rng): rng(i, 2) = Format(rng(i, 2), "dd/mm/yyyy"): Next i OneRng = "Data" Width = Array(100, 80, 80, 160, 80, 60) ColVisu = Array(6, 5, 4, 3, 2, 1): Cnt = UBound(ColVisu) + 1 For c = 1 To Cnt tmp = Range(OneRng).Offset(-1).Item(1, c) Me("Label" & c).Caption = tmp: Me("Labtxt" & c).Caption = tmp Next txtClear Me.ListBox1.ColumnCount = Cnt Me.ListBox1.ColumnWidths = Join(Width, ";") Dim result(): n = 0 For i = 1 To UBound(rng) n = n + 1: ReDim Preserve result(1 To Cnt, 1 To n) c = 0 For Each k In ColVisu c = c + 1: result(c, n) = rng(i, k) Next k Next i If n > 0 Then Me.ListBox1.Column = result: Counter = ListBox1.ListCount Else Me.ListBox1.Clear End If End Sub '***************** Sub filterdata() Dim result(): n = 0 Dim Cpt1 As String, Cpt2 As String For i = 1 To UBound(rng) 'الاسم If TextBox1.Value = "" Then Cpt1 = rng(i, 3) Else Cpt1 = "*" & TextBox1.Value & "*" 'رقم المعاملة If TextBox2.Value = "" Then Cpt2 = rng(i, 6) Else Cpt2 = "*" & TextBox2.Value & "*" If LCase(rng(i, 3)) Like LCase(Cpt1) And LCase(rng(i, 6)) Like LCase(Cpt2) Then n = n + 1: ReDim Preserve result(1 To Cnt, 1 To n) c = 0 For Each r In ColVisu c = c + 1: result(c, n) = rng(i, r) Next r End If Next i If n > 0 Then Me.ListBox1.Column = result Counter = ListBox1.ListCount Else Me.ListBox1.Clear End If txtClear End Sub '*********************** Private Sub TextBox1_Change() Call filterdata End Sub Private Sub TextBox2_Change() Call filterdata End Sub Private Sub ListBox1_Click() For i = 1 To Cnt Me("txt" & i) = Me.ListBox1.Column(i - 1) Next i End Sub '********************* Private Sub transfert_Click() Set WS = Sheets("Sheet1") WS.Cells.ClearContents n = ListBox1.ListCount: result = Me.ListBox1.List WS.[A2].Resize(n, 6) = Application.Index(result, _ Evaluate("Row(1:" & n & ")"), ColVisu) c = 0 For c = 1 To Cnt WS.Cells(1, c) = Range(OneRng).Offset(-1).Item(1, c) Next Me.TextBox1 = "": Me.TextBox2 = "" MsgBox "تم ترحيل البيانات بنجاح", Exclamation, "admin" End Sub '************************* Sub txtClear() For k = 1 To Cnt Me("txt" & k) = "" Next k End Sub كشف المعاملات المؤرشفة.xlsb

السلام عليكم ورحمه الله وبركاته اذا كان هذا ما تريد فمن فضلك قيم اجابتى وشكرا لك تغير تاريخ بناء على قيمه كمبوبوكس.accdb

🌹🌹 عدلة مرفقك كان الخطأ عند\ تغير هوامش تغير حجم عرض الحقل في آخر اليمين فقط كود تحريك الحقول ان كان صفر فتتحرك سنتيمتر 8.2 واذا كانت 1 او 2 تقل سنتيمتر عرض التقريك بتحرك الحقل ليصل الى 7 او 6 او 5 فقط وتم اضافة الاطار لكل التقارير واماكنية تحجيم الاطار والغاء واضافة قائمة بكج التقارير ==================================================== هل يوجد دالة لتحجم آخر حقل لكل تقرير من الرأس الى تذليل الصفحة آخر اليمين ؟ (لتشغيل هوامش التقرير) في الوضع الحالي سأستخدم تقرير محجم بوضع التصميم للتشغيل الهوامش وتختلف التوسع بالحقل اذا كان التقرير بوضع الطولي او العرض (افقي ) @ابو جودي اشكر كثيرا استاذي 🌹❤️ Full Control Of Print Report التحكم في الطابعة وخصائصها طباعة التقارير.rar

باش مهندسة @hanan_ms والدكتورة @safaa salem5 اتفضلو المرفق ده Full Control Of Print Report التحكم في الطابعة وخصائصها طباعة التقارير.mdb

وعليكم السلام ورحمة الله وبركاته نعم، يوجد عدد من البرامج التي توفر حماية مماثلة لبرنامج Unviewable+ لمحرر أكواد VBA، ومنها: * **VBA Protector**: أداة لحماية أكواد VBA، وتتميز بواجهة مستخدم سهلة الاستخدام وخيارات تخصيص واسعة. * **VBA Code Protector**: برنامج يركز بشكل خاص على حماية أكواد VBA من التعديل أو العرض غير المصرح به. * **VBA Encrypter**: أداة لتشفير أكواد VBA باستخدام خوارزميات تشفير قوية. * **VBA Obfuscator**: أداة لتعويق أكواد VBA من خلال إعادة تسمية المتغيرات والوظائف. * **VBA Protector Plus**: برنامج يوفر مجموعة شاملة من ميزات الحماية لأكواد VBA، بما في ذلك التشفير وإخفاء التعليمات البرمجية.

النتيجة V2.xlsm

السلام عليكم ورحمة الله تعالى وبركاته انا بصدد تصميم قاعدة بيانات فى عملى وتباعا ان شاء الله اضع بين اياديكم خلاصة مجهود وتعليم سنوات اولا تسجيل الاخطاء ومعالجتها اولا موديول باسم : basErrorHandling Public strProcessName As String ' The name of the table where errors are logged Public Const TABLE_ERROR_LOG_NAME As String = "tblErrorLog" ' Subroutine to log errors in the error log table Sub ErrorLog(ByVal intErrorNumber As Integer, ByVal strErrorDescription As String, ByVal strErrorProcessName As String) On Error GoTo Err_ErrorLog Dim strErrorMsg As String strErrorMsg = "Error " & intErrorNumber & ": " & strErrorDescription ' Show a message to the user MsgBox strErrorMsg, vbQuestion, strErrorProcessName ' Log error details in the error log table With CurrentDb.OpenRecordset(TABLE_ERROR_LOG_NAME) .AddNew ![ErrorNumber] = intErrorNumber ![ErrorDescription] = Left$(strErrorDescription, 255) ![ErrorProcessName] = strErrorProcessName ![ErrorDate] = Now() ![userName] = GetLoggedUserName() .Update .Close End With Exit_ErrorLog: Exit Sub Err_ErrorLog: ' Error message in case of an unexpected issue strErrorMsg = "An unexpected situation arose in your program." & vbNewLine strErrorMsg = strErrorMsg & "Please write down the following details:" & vbNewLine & vbNewLine strErrorMsg = strErrorMsg & "Calling Proc: " & strErrorProcessName & vbNewLine strErrorMsg = strErrorMsg & "Error Number " & intErrorNumber & vbNewLine & strErrorDescription & vbNewLine & vbNewLine strErrorMsg = strErrorMsg & "Unable to record because Error " & Err.Number & vbNewLine & Err.Description & vbNewLine strErrorMsg = strErrorMsg & "Occurred at Line: " & Erl MsgBox strErrorMsg, vbCritical, "ErrorLog()" Resume Exit_ErrorLog End Sub ' Subroutine to handle and log errors ' This subroutine checks for errors and logs them using the ErrorLog function. ' It clears the error after logging it. ' Parameters: ' - strProcName: The name of the procedure where the error occurred. Public Sub HandleAndLogError(ByVal strProcName As String) ' Check for errors If Err.Number <> 0 Then ' Handle the error and log it Call ErrorLog(Err.Number, Err.Description, strProcName) ' Clear the error Err.Clear End If End Sub ' Function to get the logged username, or return "N/A" if not available Function GetLoggedUserName() As String On Error Resume Next Dim userName As String userName = Environ("USERNAME") If Err.Number <> 0 Then userName = "N/A" Err.Clear End If On Error GoTo 0 GetLoggedUserName = userName End Function ---------------------------------------------------------------------- ثانيا مويدول باسم : basInitialization ' The name of the table where errors are logged Public Const TABLE_ERROR_LOG_NAME As String = "tblErrorLog" ' Subroutine to initialize the application Sub InitializeApplication() ' Initialize the error log table if it doesn't exist If Not IsErrorLogTableInitialized() Then CreateErrorLogTable End Sub ' Check if the error log table exists and is initialized Function IsErrorLogTableInitialized() As Boolean Dim db As DAO.Database Dim rs As DAO.Recordset ' Use error handling to check if the error log table exists On Error Resume Next Set db = CurrentDb Set rs = db.OpenRecordset(TABLE_ERROR_LOG_NAME) On Error GoTo 0 ' Check if the error log table is initialized (contains necessary fields) If Not rs Is Nothing Then On Error Resume Next rs.MoveFirst IsErrorLogTableInitialized = (Err.Number = 0) And (rs.Fields.Count >= 6) On Error GoTo 0 rs.Close End If Set rs = Nothing Set db = Nothing End Function ' Subroutine to create the error log table Sub CreateErrorLogTable() On Error Resume Next Dim db As DAO.Database Set db = CurrentDb ' Check if the table already exists If Not IsTableExists(TABLE_ERROR_LOG_NAME, db) Then ' Define the SQL code to create the table Dim strSQL As String strSQL = "CREATE TABLE " & TABLE_ERROR_LOG_NAME & " (" & _ "ID AUTOINCREMENT PRIMARY KEY, " & _ "ErrorProcessName TEXT(255), " & _ "ErrorNumber LONG, " & _ "ErrorDescription MEMO, " & _ "ErrorDate DATETIME, " & _ "UserName TEXT(255));" ' Execute the SQL command to create the table directly DoCmd.RunSQL strSQL End If Set db = Nothing On Error GoTo 0 End Sub ' Function to check if a table exists in the database Function IsTableExists(tableName As String, Optional db As DAO.Database) As Boolean ' Use DLookup to check for the existence of the table in MSysObjects On Error Resume Next Set db = IIf(db Is Nothing, CurrentDb, db) IsTableExists = Not IsNull(DLookup("Name", "MSysObjects", "Name='" & tableName & "'")) On Error GoTo 0 End Function وظيفة الموديول هو تهئة ما اريد لقاعدة البيانات البدء به ومن خلاله ---------------------------------------------------------------------- 3- نموذج البداية وليكن الان باسم frmInitialization وفى حدث عند التحميل نضع الكود الاتى Private Sub Form_Load() strProcessName = "Form Load : frmIntialization" On Error Resume Next ' Initialize the application when the startup form is loaded. InitializeApplication ' Add calls to the initialized special functions through which you want the database to be booted ' Or add specify the codes through which you would like to process the data later according to the requirements of your design ' Set the current procedure name (you can adjust the procedure name as needed) If Err.Number <> 0 Then ' Handle the error (display a message) Call ErrorLog(Err, Error$, strProcessName) ' Clear the error Err.Clear End If End Sub النتيجة المرغوب فى الخصول عليها : عند تشغيل القاعدة فى المرة الأولى تنشئ جدول تسجيل الأخطاء من تلقاء نفسها باسم الروتين او الحدث ورقم الخطاء والوصف المتطلبات عند اعداد الاكواد تباعا نمرر اسم الروتين من خلال المتغير strProcessName كما فعلت فى الحدث السابق للنموذج: strProcessName = "Form Load : frmIntialization" لو حدث اى خطأ مستقبلا سوف يتم تسجيله حتى يستطيع مطور النظم او القائم على اعمال صيانة قواعد البيانات او المصمم معرفة مكان حدوث الخطأ الشق الثانى نقوم بعمل الايقاف للاخطا ليستكمل الكود عمله حتى لو وجودت اى اخطاء من خلال : On Error Resume Next بعد كتابة الكود كما نريد وبعد ان ننتهى منه نضع الشرط التالى : If Err.Number <> 0 Then بذلك نضع شرط عند الدوران على الكود لتنفيذه فى حالة وجود خطأ اولا اظهر رسالة الخطأ حتى يعلم المستخدم سبب المشكلة ثم استدعى الدالة لتسجيل هذا الخطأ ويتم ذلك من خلال Call ErrorLog(Err, Error$, strProcessName) الان هذه بداية احترافية وعلى اسس صحيحة ومفيدة للمستقبل ..... يتبع HandleAndLogError.accdb

اتفضل يا افندم قاعدة بياانات الاحتفاظ بتصدير المراجع و المكتبات وكذلك استرجاع المراجع والمكتبات يرجى مراجعتنا بعد التجربة للتأكد ان شاء الله تقريبا بنسبة كبيرة جدا جدا تتعدى الـ 100% سوف تفلح Reference Management.accdb