ابو جودي

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

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

يا باش مهندسة لا توجد اكواد لعمل ذلك اللهم الا اذا كان السيناريو من البداية يستخدم تطبيق الاسكانر كوسيط ولو ان التطبيق يدعم ال Commanline فى هذه الحالة ممكن هذا والله اعلى واعلم طبعا عن الاكس اتحدث وليس عن لغات برمجة اخرى

اتفضل يا دكتور تدلل قم بعمل موديول جديد واعطه مصلا الاسم : basFormControlStatus الاكواد داخل الموديول Option Compare Database Option Explicit ' Description: This module contains functions related to managing record statuses in forms. Public Enum RecordStatusEnum LockedStatus NewRecordStatus EditRecordStatus CurrentRecordStatus SaveRecordStatus End Enum ' Enum: RecordStatusEnum ' Description: Defines possible control statuses for record status. ' Description: This module contains functions related to managing record statuses in forms. Public Sub SetRecordStatus(frm As Form, status As RecordStatusEnum) ' Description: Sets the status of records in a form. Dim ctl As Control ' Disable all controls by default For Each ctl In frm.Controls If IsEditableControl(ctl) Then ctl.Enabled = False End If Next ctl ' Enable or disable controls based on the specified status Select Case status Case NewRecordStatus ' Enable editable controls and move to a new record if applicable For Each ctl In frm.Controls If IsEditableControl(ctl) Then ctl.Enabled = True End If Next ctl ' If there are existing records, move to a new record If frm.Recordset.RecordCount > 0 Then DoCmd.GoToRecord , , acNewRec End If Case CurrentRecordStatus ' If no records exist or if it's a new record, enable editable controls; ' otherwise, save the record and disable editable controls. If frm.Recordset.RecordCount = 0 Or frm.NewRecord Then For Each ctl In frm.Controls If IsEditableControl(ctl) Then ctl.Enabled = True End If Next ctl Else DoCmd.RunCommand acCmdSaveRecord End If Case EditRecordStatus ' Enable editable controls for editing For Each ctl In frm.Controls If IsEditableControl(ctl) Then ctl.Enabled = True End If Next ctl Case SaveRecordStatus ' Save the record and disable editable controls DoCmd.RunCommand acCmdSaveRecord End Select End Sub Private Function IsEditableControl(ctrl As Control) As Boolean ' Description: Determines if a control is editable. Select Case ctrl.ControlType Case acTextBox, acComboBox, acCheckBox, acOptionGroup, acOptionButton, acToggleButton IsEditableControl = True Case Else IsEditableControl = False End Select End Function طريفة الاستدعاء : تبعا لوظيفة كل زر باسهل ما يكون Private Sub Form_Load() ' Set the form status to Locked when the form is loaded SetRecordStatus Me, LockedStatus End Sub Private Sub btnAddNew_Click() ' Set the form status to NewRecord when the New button is clicked SetRecordStatus Me, NewRecordStatus End Sub Private Sub btnSave_Click() ' Save the current record and set the form status to Locked when the Save button is clicked SetRecordStatus Me, SaveRecordStatus End Sub Private Sub BtnEdit_Click() ' Set the form status to EditRecord when the Edit button is clicked SetRecordStatus Me, EditRecordStatus End Sub المرفق حفظ وتعديل.accdb

بصى يا باش مهندسة حنان خلينا نتفق على شئ الاكسس لا يتعامل بمقياس السنتيمتر فى القياسات ولكن يتعامل بالـ Twips يعنى الرقم اللى حضرتك ناوية تسجليه فى الجدول هيكون بالسنتميتر وطبعا ده كان وفقا لطلب الدكتورة سلمى اللى لازم تطلع عنينا بطلباتها لانها عاوزة تسجل الهوامش بالسنتميتر طيبا علشان نحول من انا كتبت الدالة دى Public Function CmToTwips(cm As Double) As Long CmToTwips = cm * 567 End Function فطبيعيى ان حضرتك لو كتبتى ارقام غير منطقية تحصلى على نتيجة غير منطقية لذلك انا افضل فكرة حضرتك DoCmd.RunCommand acCmdPageSetup

لا شكر على واجب تحت امرك يا دكتور

اهلا بيكى يا افندم وفكرة حضرتك حلوة جدا فكرتنى بشئ انتظروا وسوف اوافيكم بأفكار رائعة ان شاء الله

والله يا دكتور انا كنت بأجهز فكرة

اتفضلى يا استاذة @safaa salem5 المرفق هوامش التقارير.accdb

هأرفع المرفق حالا ادينى دقايق اسف النور كان قاطع

هو مش بيطلبهم من حضرتك ولا حاجة حضرتك عامل ان التقرير مصدر سجلاته الجدول افتحى التقرير فى وضع التصميم هتلاقى مصدر بيانات مربعات النص مش مظبوظ علشان كده بتحثل مع حصرتك المشكلة دى

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

طيب المرفق 3 الطريقة التقليدية العادية المرفق 4 بطريقة الدالة التى قمت بشرحها قبل قليل اولا يجب تعديل مصدر بيانات مربع السرد ليحتوى على قيم الاشتراك test (3) .accdb test (4) .accdb

شوف يا سيدى انا كتبت دالة فى مودبول يعنى فى وحدة نمطية علشان نقدر نستخدمها فى اى مكان وبكل سهولة معلش يبدو انه عند التعامل معى من الوهلة تعتبرنى معقد ولكن انا اتعب قلبلا فى البداية عند بلورة الفكرة واثناء كتابتها ولكن النتيجة بعد ذلك تاتى بافضل الثمار لقد قمت بكتابة هذه الدالة Option Compare Database Option Explicit ' This function automatically fills a text box based on the value of a combo box. ' Parameters: ' form: Reference to the form containing the controls. ' comboBoxName: Name of the combo box control. ' Optional textBoxName: Name of the text box control to be filled automatically. Default is "TextBoxName". ' Optional multiSelect: Boolean to indicate if the combo box allows multiple selections. Default is False. ' Optional columnIndex: Index of the column to be used if the combo box has multiple columns. Default is 0. Public Sub FillTextBoxFromComboBox(Form As Form, comboBoxName As String, Optional textBoxName As String = "TextBoxName", Optional multiSelect As Boolean = False, Optional columnIndex As Integer = 0) ' On Error GoTo ErrorHandler ' Reference to the combo box control Dim comboBox As comboBox Set comboBox = Form.Controls(comboBoxName) ' Reference to the text box control Dim textBox As textBox Set textBox = Form.Controls(textBoxName) ' Check if the combo box contains items If comboBox.ListCount > 0 Then ' Single column case If comboBox.ColumnCount = 1 Then ' Check if multi-select is enabled If Not multiSelect Then ' Single value textBox.Value = comboBox.Value Else ' Multi-value Dim selectedItems As String Dim i As Integer For i = 0 To comboBox.ItemsSelected.Count - 1 selectedItems = selectedItems & comboBox.ItemData(comboBox.ItemsSelected(i)) & "; " Next i ' Remove the trailing semicolon If Len(selectedItems) > 2 Then selectedItems = Left(selectedItems, Len(selectedItems) - 2) Else selectedItems = "" End If textBox.Value = selectedItems End If ' Multiple columns case ElseIf comboBox.ColumnCount > 1 Then ' Check if multi-select is enabled If Not multiSelect Then ' Single value textBox.Value = comboBox.Column(columnIndex) ' Adjust the column index here as needed Else ' Multi-value For i = 0 To comboBox.ItemsSelected.Count - 1 selectedItems = selectedItems & comboBox.Column(columnIndex, comboBox.ItemsSelected(i)) & "; " ' Adjust the column index here as needed Next i ' Remove the trailing semicolon If Len(selectedItems) > 2 Then selectedItems = Left(selectedItems, Len(selectedItems) - 2) Else selectedItems = "" End If textBox.Value = selectedItems End If End If End If ' Exit Sub ' 'ErrorHandler: ' Select Case Err.Number ' Case 5 ' MsgBox "Error 5: Invalid procedure call or argument. Check if the selectedItems length is valid.", vbExclamation, "Error in FillTextBoxFromComboBox" ' Case 13 ' MsgBox "Error 13: Type mismatch. Ensure the correct data types are used.", vbExclamation, "Error in FillTextBoxFromComboBox" ' Case 91 ' MsgBox "Error 91: Object variable or With block variable not set. Ensure all controls are properly referenced.", vbExclamation, "Error in FillTextBoxFromComboBox" ' Case 424 ' MsgBox "Error 424: Object required. Ensure all controls exist on the form.", vbExclamation, "Error in FillTextBoxFromComboBox" ' Case Else ' MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "Error in FillTextBoxFromComboBox" ' End Select End Sub على ان يتم استدعاء الدالة بالشكل التالى ' Replace "ComboBoxName" and "TextBoxName" with the actual names of your controls ' Call FillTextBoxFromComboBox(Me, "ComboBoxName", "TextBoxName", False, 1) ' Adjust parameters as needed فى اى نموذج ومع اى مربع تحرير وسرد وع اى مربع نص مهما كانت الاسماء من خلال الكود المناسب تبعا للحالات التى شرحتها لك قبل قليل حسب مربع التحرير والسرد كل ما عليك فقط تغيير اسم ComboBoxName فى اكواد الاستدعاء باسم مربع السرد الذى تريد التعامل معه باحضار بياناته وكذلك تغيير اسم TextBoxName باسم مربع النص ' Single Column, Single Value: Call FillTextBoxFromComboBox(Me, "ComboBoxName") ' Single Column, Multi-Value: Call FillTextBoxFromComboBox(Me, "ComboBoxName", "TextBoxName", True) ' Multiple Columns, Single Value: Call FillTextBoxFromComboBox(Me, "ComboBoxName", "TextBoxName", False, 1) ' Column index 1 ' Multiple Columns, Multi - Value: Call FillTextBoxFromComboBox(Me, "ComboBoxName", "TextBoxName", True, 1) ' Column index 1 مرفق للتجربة Get Value Combo Box Multi Select.accdb

اولا اهلا بك بين اخوانك فى المنتدى وبعد اذن اخى الحبيب الاستاذ @عبد الله قدور ليس بالضرورة ان يحتوى مربع السرد على عدة اعمدة هذا اولا ثانيا تعالى نشوف خصائص مربع السرد قبل الاجابة قد يكون عمود واحد قد يكون اكثر من عمور قد يكون قيمته واحدة فقط قد يكون متعدد القيم نستخلص مما سبق ان لكل فرضيه طريقة واسلوب يختلف عن الاخر

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

ياريت مرفق علشان انا فهمى على ادى وانت عارف ده

اولا اعتذر لم انتبه الى رد واجابة والدى الحبيب واستاذى الجليل ومعلمى القدير الاستاذ @ابوخليل يبدو اننى كنت منهمكا فى وضع الاجابة وبعد مشاهدة اجابة والدى الحبيب يبدو انه اعتمد فى الاجابة على تحويل قيم من سنتيمتر إلى twips ولذلك اثراء للموضع الطريقة الثانية اولا ننشئ جدول باسم tblMarginsSettings يحتوى على الجقول الاتية TopMargin (نوع البيانات: Number) BottomMargin (نوع البيانات: Number) LeftMargin (نوع البيانات: Number) RightMargin (نوع البيانات: Number) إنشاء نموذج لإدخال إعدادات الهوامش عناصر التحكم اللازمة لإدخال الهوامش (مربعات نصية) txtTopMargin txtBottomMargin txtLeftMargin txtRightMargin (زر أمر) btnSaveMargins الكود Private Sub btnSaveMargins_Click() ' Ensure only one record in tblMarginsSettings If DCount("*", "tblMarginsSettings") = 0 Then ' If no record, insert a new one DoCmd.RunSQL "INSERT INTO tblMarginsSettings (TopMargin, BottomMargin, LeftMargin, RightMargin) VALUES (" & Me.txtTopMargin & ", " & Me.txtBottomMargin & ", " & Me.txtLeftMargin & ", " & Me.txtRightMargin & ")" Else ' If record exists, update it DoCmd.RunSQL "UPDATE tblMarginsSettings SET TopMargin = " & Me.txtTopMargin & ", BottomMargin = " & Me.txtBottomMargin & ", LeftMargin = " & Me.txtLeftMargin & ", RightMargin = " & Me.txtRightMargin End If MsgBox "Margins settings saved successfully!" End Sub إنشاء الوحدة النمطية لإضافة الدالة العامة الكود Public Function CmToTwips(cm As Double) As Long CmToTwips = cm * 567 End Function وذلك لتحويل القيم من سنتيمتر إلى twips Public Sub SetReportMargins(rpt As Report, _ Optional ByVal DefaultTopCm As Double = 2.54, _ Optional ByVal DefaultBottomCm As Double = 2.54, _ Optional ByVal DefaultLeftCm As Double = 2.54, _ Optional ByVal DefaultRightCm As Double = 2.54) ' Convert default values from cm to twips Dim DefaultTop As Long Dim DefaultBottom As Long Dim DefaultLeft As Long Dim DefaultRight As Long DefaultTop = CmToTwips(DefaultTopCm) DefaultBottom = CmToTwips(DefaultBottomCm) DefaultLeft = CmToTwips(DefaultLeftCm) DefaultRight = CmToTwips(DefaultRightCm) Dim rs As DAO.Recordset On Error GoTo ErrorHandler Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblMarginsSettings") If Not rs.EOF Then rpt.Printer.TopMargin = CmToTwips(Nz(rs!TopMargin, DefaultTopCm)) rpt.Printer.BottomMargin = CmToTwips(Nz(rs!BottomMargin, DefaultBottomCm)) rpt.Printer.LeftMargin = CmToTwips(Nz(rs!LeftMargin, DefaultLeftCm)) rpt.Printer.RightMargin = CmToTwips(Nz(rs!RightMargin, DefaultRightCm)) Else rpt.Printer.TopMargin = DefaultTop rpt.Printer.BottomMargin = DefaultBottom rpt.Printer.LeftMargin = DefaultLeft rpt.Printer.RightMargin = DefaultRight End If rs.Close Set rs = Nothing Exit Sub ErrorHandler: MsgBox "Error setting margins: " & Err.Description If Not rs Is Nothing Then rs.Close Set rs = Nothing End If End Sub على ان يتم الاستدعاء فى التقرير عند فتح التقرير بالشكل التالى Private Sub Report_Open(Cancel As Integer) SetReportMargins Me End Sub

اولا ننشئ جدول باسم tblMarginsSettings يحتوى على الجقول الاتية TopMargin (نوع البيانات: Number) BottomMargin (نوع البيانات: Number) LeftMargin (نوع البيانات: Number) RightMargin (نوع البيانات: Number) إنشاء نموذج لإدخال إعدادات الهوامش عناصر التحكم اللازمة لإدخال الهوامش (مربعات نصية) txtTopMargin txtBottomMargin txtLeftMargin txtRightMargin (زر أمر) btnSaveMargins الكود Private Sub btnSaveMargins_Click() ' Ensure only one record in tblMarginsSettings If DCount("*", "tblMarginsSettings") = 0 Then ' If no record, insert a new one DoCmd.RunSQL "INSERT INTO tblMarginsSettings (TopMargin, BottomMargin, LeftMargin, RightMargin) VALUES (" & Me.txtTopMargin & ", " & Me.txtBottomMargin & ", " & Me.txtLeftMargin & ", " & Me.txtRightMargin & ")" Else ' If record exists, update it DoCmd.RunSQL "UPDATE tblMarginsSettings SET TopMargin = " & Me.txtTopMargin & ", BottomMargin = " & Me.txtBottomMargin & ", LeftMargin = " & Me.txtLeftMargin & ", RightMargin = " & Me.txtRightMargin End If MsgBox "Margins settings saved successfully!" End Sub إنشاء الوحدة النمطية لإضافة الدالة العامة الكود Public Sub SetReportMargins(rpt As Report, _ Optional ByVal DefaultTop As Long = 1440, _ Optional ByVal DefaultBottom As Long = 1440, _ Optional ByVal DefaultLeft As Long = 1440, _ Optional ByVal DefaultRight As Long = 1440) ' Default values are set to 1 inch (1440 twips) which is standard for A4 paper Dim rs As DAO.Recordset On Error GoTo ErrorHandler Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblMarginsSettings") If Not rs.EOF Then rpt.Printer.TopMargin = Nz(rs!TopMargin, DefaultTop) rpt.Printer.BottomMargin = Nz(rs!BottomMargin, DefaultBottom) rpt.Printer.LeftMargin = Nz(rs!LeftMargin, DefaultLeft) rpt.Printer.RightMargin = Nz(rs!RightMargin, DefaultRight) Else rpt.Printer.TopMargin = DefaultTop rpt.Printer.BottomMargin = DefaultBottom rpt.Printer.LeftMargin = DefaultLeft rpt.Printer.RightMargin = DefaultRight End If rs.Close Set rs = Nothing Exit Sub ErrorHandler: MsgBox "Error setting margins: " & Err.Description If Not rs Is Nothing Then rs.Close Set rs = Nothing End If End Sub على ان يتم استدعاءه فى التقرير عندف تح التقرير بالشكل التالى Private Sub Report_Open(Cancel As Integer) SetReportMargins Me End Sub وبذلك يكون هناك مرونة مع المعلمات الافتراضية للدالة SetReportMargins تتيح تحديد هوامش افتراضية في حال عدم وجود قيم في الجدول تم استخدام معايير A4 حيث ان القيم الافتراضية للهوامش تعادل 1 بوصة (1440 twips) لكل جانب وهي مناسبة لمقاسات ورق A4 يمكن استدعاء الدالة من أي تقرير بسهولة باستخدام هذا الكود، ستكون إعدادات الهوامش مرنة وقابلة للتعديل بسهولة، مع التأكد من وجود قيم افتراضية مناسبة عند الحاجة.

تم افراد موضوع لاستعراض وشرح الاكواد والافكار والية العمل هنا

تحويل الوقت والتاريخ المحلى الي التوقيت عن التوقيت العالمي الموحد (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

المرفق الثانى TimeZones UP 2.zip

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

المرفق الأول البسيط TimeZones.accdb

جارى تحضير مقاجأه