ابو جودي

صباح الخيرات كان يسأل عنه من قبل بعض الاخوة الاحباب

انصحك بوضع المرفق لايضاح الرؤية لان الاجابات والافكار بتختلف تبعا لاسلوب والية الاكواد والافكار فى التصميم كده هنفضل نلف حوالين نفسنا وياك من غير مرفق

لتصميم الشاشة الرئيسية وسهولة التحكم فىيها تم اضافة جدول جديد باسم tblFormsTitle يتكون من الحقول FormName = اسم النموذج الفرعى FormDesc = وصف النموذج ( معيار احضار بيانات اسم النموذج والعنوان فى الكود) TitleForm = العنوان فى الشاشة الرئيسية البيانات داخل الجدول كالاتى اسم النموذج الفرعى وصف النموذج ( معيار احضار بيانات اسم النموذج والعنوان فى الكود) العنوان فى الشاشة الرئيسية frmHomeMenu HomeMenu الرئيسية frmSub1ImportOraclExcel ImportExcel استيراد بيانات الحضور والانصراف ( Oracle's Excel sheet ) frmSub2DailyEmployee DailyEmployee ادارة يوميات الموظفين ( اضافة / تعديل / حذف ) frmSub3QueryDaily QueryDailyBy استعلام وتقارير يوميات الموظفين frmSub4Employees EmployeesData ادارة بيانات الموظفين ( اضافة / تعديل / حذف ) frmSub5DailyLogsType DailyLogsType ادارة انواع اليوميات ( اضافة / تعديل / حذف ) frmSub6Department Department ادارة بيانات الادارات و المديرين ( اضافة / تعديل / حذف ) frmSub7Section Section ادارة بيانات الاقسام ( اضافة / تعديل / حذف ) تم تصميم النماذج الفرعية بدون اى مصدر بيانات .... عمل نموذج رئيسي باسم frmMain فى وضع التصميم تم اضافة نموذج فرعى غير منضم باسم subformControl تم اضافة مربع تسمية ( Lable ) باسم lblTitle اضافة عدد سبع ازرار باسماء btnNavItem1 ,btnNavItem2 , btnNavItem3 , ........ الخ عنصر تحكم صورة باسم imgArrow يحتوى على شكل سهم الاكواد فى النموذج قائمة بوظائف الازرار تبعا لوصف النماذج من الجدول والذى اشرنا الى الحقل الخاص به وصف النموذج ( معيار احضار بيانات اسم النموذج والعنوان فى الكود) ' Enum to define button actions Enum ButtonAction HomeMenu ImportExcel DailyEmployee QueryDailyBy EmployeesData DailyLogsType Department Section End Enum متغيرات لاسناد قيم اليها ' Declare variables to store form name and title Private strFormName As String Private strTitleForm As String Private subformInfoArray As Variant دالة لتحديد المعيار لجلب البيانات للنماذج الفرعية من الجدول ( اسم النموذج - العنوان فى الشاشة الرئيسية ) بناء على Enum قائمة الازرار ' Sub to handle button click events Private Sub HandleButtonClick(btnAction As ButtonAction) Dim subformInfoResult As String ' Get subform information based on the button action subformInfoResult = GetSubformInfo(ButtonActionToString(btnAction)) ' Process the subform information and update the form ProcessSubformInfo subformInfoResult End Sub دالة لاحضار معلومات النماذج الفرعية من الجدول ( اسم النموذج - العنوان فى الشاشة الرئيسية ) بناء على المعيار من الدالة السابقة ' Function to get the name and title of the subform based on the form description Function GetSubformInfo(subformDesc As String) As String ' Use On Error Resume Next to handle errors gracefully On Error Resume Next ' Declare a DAO Recordset variable Dim rs As DAO.Recordset ' Open a recordset based on the provided form description Set rs = CurrentDb.OpenRecordset("SELECT FormName, TitleForm FROM tblFormsTitle WHERE FormDesc='" & subformDesc & "'") ' Check if the recordset is not empty If Not rs.EOF Then ' Return the concatenated string of FormName and TitleForm GetSubformInfo = rs!formName & "," & rs!titleForm Else ' Return an empty string if no matching record is found GetSubformInfo = "" End If ' Close the recordset to free up resources rs.Close Set rs = Nothing ' Check for errors and display debug information If Err.Number <> 0 Then MsgBox "Error retrieving subform information: " & Err.Description, vbExclamation Err.Clear End If End Function دالة لفصل اسم النموذج والعنوان والذى تم الحصول عليهم من الدالة السابقة ' Sub to process subform information and update the form Sub ProcessSubformInfo(subformInfoResult As String) ' Split the subformInfo into an array subformInfoArray = Split(subformInfoResult, ",") ' Extract the formName and title from the array If UBound(subformInfoArray) >= 1 Then strFormName = Trim(subformInfoArray(0)) strTitleForm = subformInfoArray(1) End If ' Update the form based on the subform information UpdateFormBasedOnSubformInfo End Sub دالة للتحكم فى اظهار واخفاء موضع صورة سهم تدل على النموذج الفرعى تبعا لزر الامر ' Sub to move the arrow indicator on the form Sub MoveArrow() ' Make the arrow visible and position it below the active control If Not Me.imgArrow.Visible Then Me.imgArrow.Visible = True Me.imgArrow.Top = Me.ActiveControl.Top ChangeCommandButtonColor Me End Sub دالة تحديث النموذج بناء على المعطيات السابقة من الدوال بمجرد النقر على زر الامر ' Sub to update the form based on the subform information Sub UpdateFormBasedOnSubformInfo() Select Case Nz(strFormName, "frmHomeMenu") Case Is = "frmHomeMenu" Me.lblTitle.Caption = strTitleForm subformControl.Visible = False ChangeCommandButtonColor Me, False Me.imgArrow.Visible = False Me.subformControl.SourceObject = "" Me.subformControl.Height = 0 Case Else Me.lblTitle.Caption = strTitleForm MoveArrow ChangeCommandButtonColor Me Me.subformControl.Height = BoxMain.Height Me.subformControl.SourceObject = strFormName subformControl.Visible = True End Select End Sub الاكواد لضبط وتحديد الحدث المراد تنفيذه تبعا لازرار الاوامر ' Function to convert ButtonAction to corresponding form description Function ButtonActionToString(btnAction As ButtonAction) As String Select Case btnAction Case ButtonAction.HomeMenu: ButtonActionToString = "HomeMenu" Case ButtonAction.ImportExcel: ButtonActionToString = "ImportExcel" Case ButtonAction.DailyEmployee: ButtonActionToString = "DailyEmployee" Case ButtonAction.QueryDailyBy: ButtonActionToString = "QueryDailyBy" Case ButtonAction.EmployeesData: ButtonActionToString = "EmployeesData" Case ButtonAction.DailyLogsType: ButtonActionToString = "DailyLogsType" Case ButtonAction.Department: ButtonActionToString = "Department" Case ButtonAction.Section: ButtonActionToString = "Section" End Select End Function الاكواد على ازرار الاوامر Private Sub ImageLogo_Click() HandleButtonClick HomeMenu End Sub Private Sub btnNavItem1_Click() HandleButtonClick ImportExcel End Sub Private Sub btnNavItem2_Click() HandleButtonClick DailyEmployee End Sub Private Sub btnNavItem3_Click() HandleButtonClick QueryDailyBy End Sub Private Sub btnNavItem4_Click() HandleButtonClick EmployeesData End Sub Private Sub btnNavItem5_Click() HandleButtonClick DailyLogsType End Sub Private Sub btnNavItem6_Click() HandleButtonClick Department End Sub Private Sub btnNavItem7_Click() HandleButtonClick Section End Sub واخيرا وحدة نمطية باسم basChangeButtonColor خاصة بتغير لون زر الامر الذى يتم الضغط عليه فى النموذج الرئيسى ' Enum for colors Enum ColorEnum WhiteColor = 16777215 ' White RedColor = 255 ' Red GreenColor = 32768 ' Green BlueColor = 16711680 ' Blue PurpleColor = 8388736 ' Purple GrayColor = 8421504 ' Gray OrangeColor = 16753920 ' Orange BrownColor = 10824234 ' Brown BlackColor = 0 ' Black CyanColor = 16776960 ' Cyan MagentaColor = 16711935 ' Magenta YellowColor = 65535 ' Yellow LightBlueColor = 173216230 ' Light Blue DarkGreenColor = 65280 ' Dark Green PinkColor = 16761035 ' Pink LavenderColor = 230230250 ' Lavender OliveColor = 32896 ' Olive AquaColor = 65535 ' Aqua TurquoiseColor = 4251856 ' Turquoise GoldColor = 16766720 ' Gold SilverColor = 12632256 ' Silver MaroonColor = 8388608 ' Maroon NavyColor = 128 ' Navy TealColor = 8421376 ' Teal CoralColor = 5275647 ' Coral SalmonColor = 16416882 ' Salmon IndigoColor = 4915330 ' Indigo PeachColor = 16775640 ' Peach SiennaColor = 10506797 ' Sienna SkyBlueColor = 8900331 ' Sky Blue End Enum ' Module-level variables Dim currentButtonBackColor As Long ' Variable to store the current button back color Dim currentButtonForeColor As Long ' Variable to store the current button fore color Dim selectedButton As CommandButton ' Variable to store the selected button ' Subroutine to set the button color Sub SetButtonColor(ByVal frm As Form, Optional btn As CommandButton = Nothing) ' Set new button colors Dim newButtonBackColor As Long Dim newButtonForeColor As Long newButtonBackColor = ColorEnum.GrayColor newButtonForeColor = ColorEnum.BlackColor If Not btn Is Nothing Then ' Store the current button's colors currentButtonBackColor = btn.BackColor currentButtonForeColor = btn.ForeColor ' Clear the previous button's highlight If Not selectedButton Is Nothing Then selectedButton.BackColor = currentButtonBackColor selectedButton.ForeColor = currentButtonForeColor End If ' Set the new button as selected and highlight it Set selectedButton = btn btn.BackColor = newButtonBackColor btn.ForeColor = newButtonForeColor End If End Sub ' Subroutine to change the button color Sub ChangeCommandButtonColor(frm As Form, Optional changeColor As Boolean = True) On Error GoTo ErrorHandler Dim clickedButton As CommandButton Set clickedButton = frm.ActiveControl ' Store the default button colors before changing Dim currentButtonBackColor As Long Dim currentButtonForeColor As Long currentButtonBackColor = clickedButton.BackColor currentButtonForeColor = clickedButton.ForeColor ' Clear the previous button's highlight If Not selectedButton Is Nothing Then selectedButton.BackColor = currentButtonBackColor selectedButton.ForeColor = currentButtonForeColor End If ' Set the new button as selected and highlight it Set selectedButton = clickedButton ' Apply the button color if changeColor is True If changeColor Then SetButtonColor frm, clickedButton End If Err.Clear ' Clear Err Exit Sub ' Exit to avoid handler. ErrorHandler: ' Error-handling routine. Select Case Err.Number ' Evaluate error number. Case Is = 5 Resume Next Exit Sub ' Exit to avoid handler. Case Else ' Handle other situations here... MsgBox "Error: " & Err.Number & vbCrLf & "Description: " & Err.Description Resume ' Resume execution at the same line End Select End Sub المميزات : 1- عند الابتعاد عن الشاشة والعودة مرة أخرى بمجرد النظر يمكنك معرفة الزر الاخير الذى تم الضغط عليه 2-سهولة تغيير العناوين التى تظهر على الشاشة الرئيسية تبعا لكل نموذج فرعى بكل سهولة بدون داعى للدخول الى عرض التصميم من الجدول اختبار تجربة يتبع ... واخيرا المرفق HRManagement V 1.0.2.zip

هذه الدوال كانت تعمل على النواة 32 بدون اى مشاكل ولكن لم تعمل مع النواة 64 تمت التعديلات اللازمة على الكود للعمل على النواتان 32,64 بيت تم التجربة الشخصية والتأكد من فاعلية هذه التعديلات على ويندوز 64 بيت اوفيس 64 بيت فضلا وليس امرا فى انتظار ارائكم والردود بعد التجربة على انوية مختلفة للتأكد من فاعلية التعديل Option Compare Database Option Explicit #If Win64 Then ' Declare functions for 64-bit Windows Private Declare PtrSafe Function NetRemoteTOD Lib "Netapi32.dll" ( _ bServer As Any, pBuffer As LongPtr) As Long Private Declare PtrSafe Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As LongPtr) As Long #Else ' Declare functions for 32-bit Windows Private Declare Function NetRemoteTOD Lib "Netapi32.dll" ( _ bServer As Any, pBuffer As Long) As Long Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As Long #End If #If VBA7 Then ' Declare functions for VBA7 (Office 2010 and later) Private Declare PtrSafe Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr) #Else ' Declare functions for earlier versions of VBA Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) #End If ' Define custom data types for SYSTEMTIME, TIME_ZONE_INFORMATION, and TimeOfDayInfo Private Type 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 Private Type TIME_ZONE_INFORMATION Bias As Long StandardName(32) As Integer StandardDate As SYSTEMTIME StandardBias As Long DaylightName(32) As Integer DaylightDate As SYSTEMTIME DaylightBias As Long End Type Private Type TimeOoDayInfo tod_elapsedt As Long tod_msecs As Long tod_hours As Long tod_mins As Long tod_secs As Long tod_hunds As Long tod_timezone As Long tod_tinterval As Long tod_day As Long tod_month As Long tod_year As Long tod_weekday As Long End Type ' Constant for success code Private Const NERR_SUCCESS As Long = 0 ' Constant for default time indicating failure Private Const DEFAULT_TIME As Date = #12:00:00 AM# Public myIP As String ' Function to get Time Of Day from a remote server Private Function GetTOD(ByVal Server As String) As Date #If VBA7 Then Dim lngBufPtr As LongPtr #Else Dim lngBufPtr As Long #End If Dim bytServer() As Byte Dim todReturned As TimeOoDayInfo Dim success As Boolean On Error Resume Next ' Convert server string to null-terminated byte array bytServer = Trim$(Server) & vbNullChar ' Call NetRemoteTOD function and check for success success = NetRemoteTOD(bytServer(0), lngBufPtr) = NERR_SUCCESS On Error GoTo 0 If success Then ' Copy memory and free buffer CopyMemory todReturned, ByVal lngBufPtr, LenB(todReturned) NetApiBufferFree lngBufPtr ' Calculate date and time from TimeOoDayInfo structure With todReturned GetTOD = DateAdd("n", _ -.tod_timezone, _ DateSerial(.tod_year, .tod_month, .tod_day) _ + TimeSerial(.tod_hours, .tod_mins, .tod_secs)) End With Else ' Return default time in case of failure GetTOD = DEFAULT_TIME End If End Function ' Subroutine to get remote time and display a message Public Function GetRemoteTime(ByVal ServerIP As String) Dim d As Date ' Call GetTOD function with a sample IP address d = GetTOD(ServerIP) ' Check if the returned time is the default time indicating failure If d = DEFAULT_TIME Then ' Display an error message MsgBox "Failed to get remote time. Please check the IP address or ensure the server is reachable.", vbExclamation Else ' Print the remote time to the Debug window GetRemoteTime = d Debug.Print d End If End Function Sub Test_setIP() myIP = "192.168.0.133" Call GetRemoteTime(myIP) End Sub طبعا لابد من تعديل الـ Ip بجهاز اخر على الشبكة المحلية myIP = "192.168.0.133"

الان الجداول الاساسية المرفق بالجداول اللازمة HR Managment.zip

طيب فى الاستعلام مصدر التقرير حقل تاريخ البطاقة لو اسمه CardDate اضف حقل جديد فى الاستعلام بالشكل التالى Year(CardDate) ولعرض البطاقات الفعالة فقط فى المعيار لهذا الحقل ضع : >=Year(Date()) ولعرض البطاقات الغير فعالة فقط فى المعيار لهذا الحقل ضع : <Year(Date()) طيب انت لو استخدمت العلامات اكبر من واصغر من فقط سوف يتم التعامل مع التاريخ كاملا ولكن بما انك تريد التعامل مع السنوات لابد من ارجاع التاريخ اولا للعام للحقل وللمعيار

البيانات الرئيسية والتى نريد تحضيرها مرة واحدة فقط عند بدء التطيق لنتمكن من استخدامها فى زوايا التطبيق المختلفة على سبيل المثال وليس الحصر نريد اسم الشركة دائما فى كل التقارير مثلا عند تحقق شرط معين بيانات الاتصال بالمصمم لعمل ذلك نقوم ببناء جدول ليكون اسمه tblGlobalInformation بناء الجدول يعتمد على حقلين itemName , itemValue والان وحدة نمطية جديدة ليكون اسمها = basGlobalInformation فى الوحدة النمطية نقوم بعمل Enumeration هي كلاسات خاصة تستخدم لتعريف ثوابت محددة مسبقا وتستخدم لتخزين عناصر متتالية دفعة واحدة بعدها يمكنه إرجاع هذه العناصر واحدا تلو الآخر حسب الحاجة الاكواد داخل الوحدة النمطية basGlobalInformation Option Compare Database Option Explicit ' Enumeration defining global information indices Public Enum EnumInformation EnumStartIndex ' Enumeration values for global information start infSoftwarName infSoftwarVersion infDesignCompany infDesigerName infDesigerMail infDesigerPhone infCompanyName infCompanyGM EnumEndIndex = infCompanyGM ' Enumeration value for global information end End Enum ' Array to store global information values Public Ginf() As String ' Public variables to store individual global information values Public GetSoftwarName As String Public GetSoftwarVersion As String Public GetDesignCompany As String Public GetDesigerName As String Public GetDesigerMail As String Public GetDesigerPhone As String Public GetCompanyName As String Public GetCompanyGM As String ' The name of the table Global Information Public Const TableGlobalInformationName As String = "tblGlobalInformation" Function IsArrayInitialized(arr As Variant) As Boolean ' Check if the array is initialized (not empty or uninitialized) On Error Resume Next IsArrayInitialized = (UBound(arr) >= LBound(arr)) On Error GoTo 0 End Function Public Sub SetGlobalVariables() ' Procedure to set global variables based on database values On Error Resume Next ' Open a recordset based on the SQL query Dim db As DAO.Database Dim rs As DAO.Recordset Dim strSQL As String Set db = CurrentDb ' Check if the table exists in the database If Not IsTableExists(TableGlobalInformationName, db) Then Exit Sub ' Check if global information values are already populated If Not IsArrayInitialized(Ginf) Then ' Resize the global information values array based on the count of enumeration items ReDim Ginf(1 To EnumEndIndex - EnumStartIndex) As String ' Create a SQL query to retrieve all required items in one go strSQL = "SELECT itemName, itemValue FROM " & TableGlobalInformationName & " WHERE itemName " & _ "IN ('SoftwarName', 'SoftwarVersion', 'DesignCompany', 'DesigerName', " & _ "'DesigerMail', 'DesigerPhone', 'CompanyName', 'CompanyGM');" ' Open a recordset based on the SQL query Set rs = db.OpenRecordset(strSQL) ' Loop through the recordset and assign values to global information values array Do While Not rs.EOF Dim itemName As String itemName = rs.Fields("itemName").Value Dim itemIndex As Integer itemIndex = GetInfoIndex(itemName) If itemIndex <> -1 Then Ginf(itemIndex) = rs.Fields("itemValue").Value Else Debug.Print "ItemName: " & itemName & " not found in EnumInf." End If rs.MoveNext Loop ' Assign individual global information values to public variables GetSoftwarName = Ginf(EnumInformation.infSoftwarName) GetSoftwarVersion = Ginf(EnumInformation.infSoftwarVersion) GetDesignCompany = Ginf(EnumInformation.infDesignCompany) GetDesigerName = Ginf(EnumInformation.infDesigerName) GetDesigerMail = Ginf(EnumInformation.infDesigerMail) GetDesigerPhone = Ginf(EnumInformation.infDesigerPhone) GetCompanyName = Ginf(EnumInformation.infCompanyName) GetCompanyGM = Ginf(EnumInformation.infCompanyGM) ' Close the recordset rs.Close Set rs = Nothing End If ' Handle errors If Err.Number <> 0 Then ' Handle error If Err.Number = 94 Then Exit Sub ' Handle the error (display a message) Call ErrorLog(Err, Error$, "basEnumInformationrmation : SetGlobalVariables") Err.Clear End If On Error GoTo 0 End Sub Function GetInfoIndex(itemName As String) As Integer ' Helper function to get the index of an item in the EnumInformation enumeration Select Case itemName Case "SoftwarName" GetInfoIndex = EnumInformation.infSoftwarName Case "SoftwarVersion" GetInfoIndex = EnumInformation.infSoftwarVersion Case "DesignCompany" GetInfoIndex = EnumInformation.infDesignCompany Case "DesigerName" GetInfoIndex = EnumInformation.infDesigerName Case "DesigerMail" GetInfoIndex = EnumInformation.infDesigerMail Case "DesigerPhone" GetInfoIndex = EnumInformation.infDesigerPhone Case "CompanyName" GetInfoIndex = EnumInformation.infCompanyName Case "CompanyGM" GetInfoIndex = EnumInformation.infCompanyGM End Select End Function طيب بما اننا نتكلم عن اعدادات مهمة لابد من تحقيقها عند بدء التطبيق سوف نقوم بعمل وحدة نمطية باسم basInitialization ونضع بها الاكواد الاتية Rem Subroutine to initialize the application Sub InitializeApplication() Rem Initialize the error log table if it doesn't exist If Not IsErrorLogTableInitialized() Then CreateErrorLogTable Rem Call the function to set global variables. SetGlobalVariables End Sub ونقوم بعمل نموذج البدء ليكون اسمه frmInitialization فى هذا النموذج نستدعى الدالة السابقة فى حدث عند تحميل النموذج بالشكل التالى Private Sub Form_Load() On Error Resume Next Rem Set the initial time as the interval for the timer Rem Initialize the application when the startup form is loaded. InitializeApplication Rem Add calls to the initialized special functions through which you want the database to be booted Rem Or add specify the codes through which you would like to process the data later according to the requirements of your design Rem Set the current procedure name (you can adjust the procedure name as needed) If Err.Number <> 0 Then Rem Clear the error Err.Clear End If End Sub يتبع ... واخيرا المرفق HRManagement V 1.0.0.accdb

ولا انا انا جاوبت نظريا بناء على السؤال انا لا استطيع الان رفع او تنزيل اى مرفقات

وليه كل ده التسيق الشرطى اسرع اسهل

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

لا شكر على واجب U Welcome

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

طيب جرب المرفق ده Goporodact_3.rar

أستاذ @سامر محمود ابشر لكن الموضوع كبير وبيأخذ وقت والاستاذ @kkhalifa1960 شغال عليه .

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

اتفضل فى زر استدعاء انتاج امس ضع الكود الاتى ' Check if the form is not in a new record state If Not Me.NewRecord Then ' Refresh the form to ensure current data is saved Me.Refresh ' Disable warnings to suppress confirmation messages DoCmd.SetWarnings False ' Open the first update query with DISTINCT DoCmd.OpenQuery "qryDoAllSaelsExchDistinct" ' Open the second update query with DISTINCT DoCmd.OpenQuery "qryDoAllSaelsExchTowDistinct" ' Enable warnings back DoCmd.SetWarnings True ' Requery subforms to reflect the changes Frm_AllSaels_Exch_Subform.Requery AllSaels_ExchTow.Requery ' Display a success message MsgBox "Record updated successfully!", vbInformation Else ' Display a message if trying to update a new record MsgBox "Please save the current record before updating.", vbExclamation End If وقم بعمل استعلامين جملة SQL الاستعلام الاول ولا تنسى حفظ الاستعلام باسم : qryDoAllSaelsExchDistinct INSERT INTO AllSaels_Exch ( Odb_ID, Odb_DateMov, Odb_CodMont, Odb_NameItem, Odb_Unet, Odb_UnetEn, Odb_Qty, Odb_ValueAms, Odb_Qtypro, Odb_QtyAms, Odb_Valuetotal, Odb_QtySham, Odb_QtySil, Odb_Skv, Odb_Moamil, Odb_Sv, Odb_Balance, Odb_Haly ) SELECT [Forms]![Frm_IDOrdaerPrimr]![IDNo] AS Odb_ID, [Forms]![Frm_IDOrdaerPrimr]![DatOr] AS Odb_DateMov, AllSaels_Exch.Odb_CodMont, AllSaels_Exch.Odb_NameItem, AllSaels_Exch.Odb_Unet, AllSaels_Exch.Odb_UnetEn, AllSaels_Exch.Odb_Qty, AllSaels_Exch.Odb_ValueAms, AllSaels_Exch.Odb_Qtypro, AllSaels_Exch.Odb_QtyAms, AllSaels_Exch.Odb_Valuetotal, AllSaels_Exch.Odb_QtySham, AllSaels_Exch.Odb_QtySil, AllSaels_Exch.Odb_Skv, AllSaels_Exch.Odb_Moamil, AllSaels_Exch.Odb_Sv, AllSaels_Exch.Odb_Balance, AllSaels_Exch.Odb_Haly FROM AllSaels_Exch WHERE AllSaels_Exch.Odb_DateMov = (SELECT MAX(Odb_DateMov) FROM AllSaels_Exch); جملة SQL الاستعلام الاول ولا تنسى حفظ الاستعلام باسم : qryDoAllSaelsExchTowDistinct INSERT INTO AllSaels_ExchTow (Odb_ID, Odb_Datr, Odb_Desc, Odb_Unet, Odb_QtyDay, Odb_VuliDay, Odb_QtyAms, Odb_VuliAms) SELECT [Forms]![Frm_IDOrdaerPrimr]![IDNo] AS Odb_ID, [Forms]![Frm_IDOrdaerPrimr]![DatOr] AS Odb_Datr, Odb_Desc, Odb_Unet, Odb_QtyDay, Odb_VuliDay, Odb_QtyAms, Odb_VuliAms FROM AllSaels_ExchTow WHERE Odb_Datr = (SELECT MAX(Odb_Datr) FROM AllSaels_ExchTow); بس يا سيدى خلصت الحكاية شوقت سهله ازاى روح ع النموذج سم باسم الله وجرب

يا استاذ @kkhalifa1960 علشان كده فى الحالات دى بأفضل الاضافة المباشرة ع الجدول من الريكورد ست ومالها بس الاكواد ما هى زى العسل .... فله وشمعه منوره وبتعطى الاريحية الواحد يتخيل وينام ويصحى وياكل فى الكود ويعمل كل للى نفسه فيه براحته والله نفسى انام بقالى 3 ايام صاحى حد عنده كود يعمل شت دون للبنى ادمين ويكسب فى صواب

طيب ممكن بعد اذن استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل اضيف شئ صغنون من واقع تجربة عملية سابقة لى اعتقد الاستعلام بدون اقواس بالشكل الاتى سوف يكون افضل لان استخدام الأقواس ([]) في أسماء الحقول قد يؤدي إلى مشكلات في بعض الحالات وهذا عن تجربة شخصية ولا يتطوع او يتبرع أحد ويسألنى عن السبب لأننى فعلا لا أعرف SELECT Data1.ID, Data1.namee, Data1.edara, Data1.woork, Data1.egraa FROM Data1 WHERE (Data1.namee Like "*" & [Forms]![Data1]![Combo17] & "*") AND (Data1.egraa Like "*" & [Forms]![Data1]![Combo19] & "*");

يعنى البيانات اللى فى الجدول AllSaels_Exch والجدول AllSaels_ExchTow ثابتين لا يتغيروا وبس تريد تكرارهم مرة أخرى للجدواول بتاريخ اليوم الجديد ؟

طيب وهذه فوكيره ثغنونه لو كان مصدر التحرير والسرد استعلام خارجى DataUp3.rar

ولا انا لا اؤيدها هههههههههههه انا طويلب علم مسكين

هههههههههه لسه احكى يا جبل ما يهزك ريح ولكن يبدو .. هههههههههههههههههههههههههههههه ...... والله اشتجنا انا بس لاقيتك ساكت قلت فى نفسى لا اسكت الله لك حسا يا استاذ @Moosak وكان لازم ولابد وحتما نهز الورد يا ورد بس جت على راسى استاذى الجليل ومعملى القدير و والدى الحبيب الاستاذ @ابوخليل تصدر لك ودافع عنك وزعق لى

يعلم الله كم احب انا الاستاذ @Moosak ولكن اهز الورد ظللت اهز و اهز واهز ولكن مثل ما ينحكى يا جبل ما يهزك ريح

شكرا اختنا الغالية @safaa salem5 جزاكم الله خيرا ولكن اهمس اليك لتعلمى الاستاذ ابوخليل انه فى مقام الوالد عندما يذكر يتقدمنا جميعا ومثله الاستاذ جعفر تذكرى ذلك هؤلاء اعمدة المنتدى هم اساتذتنا جميعا ونتعلم منهم وعلى ايديهم لا ينبغى ان يتقدم اى اسم مهما كان اسم معلمينا العظماء

وحتى تزيد الحيره اعتمدت فى هذا الكود على تعريف متغير نصى ليتعامل مه الكلمات المحجوزة keywords = "FROM;WHERE;GROUP BY;HAVING;ORDER BY;" والتعديلات كاملة تكون Sub ExtractTableNameFromRowSource(cbo As ComboBox) ' Check if RowSource is not empty If cbo.rowSource = "" Then MsgBox "RowSource is empty", vbExclamation, "Warning" Exit Sub End If ' Extract table name from RowSource Dim tableName As String tableName = GetTableNameFromRowSource(cbo.rowSource) ' Remove trailing semicolon if exists If Right(tableName, 1) = ";" Then tableName = Left(tableName, Len(tableName) - 1) End If ' Display the table name without additional message MsgBox tableName, vbInformation, "Table Information" End Sub Function GetTableNameFromRowSource(rowSource As String) As String ' Define reserved keywords Dim keywords As String keywords = "FROM;WHERE;GROUP BY;HAVING;ORDER BY;" ' Find the part that starts with "FROM" in RowSource Dim fromIndex As Integer fromIndex = InStr(1, rowSource, "FROM ", vbTextCompare) ' Make sure the word "FROM" is in RowSource If fromIndex = 0 Then MsgBox "RowSource does not contain the word 'FROM'", vbExclamation, "Warning" Exit Function End If ' Extract the part of the text that contains the table name after "FROM" Dim tableNamePart As String tableNamePart = Mid(rowSource, fromIndex + Len("FROM ")) ' Check for reserved keywords and remove them Dim keywordIndex As Integer keywordIndex = InStr(1, tableNamePart, keywords, vbTextCompare) ' Find the position of the first space, semicolon, or keyword after the table name Dim delimiterIndex As Integer delimiterIndex = IIf(keywordIndex > 0, keywordIndex, _ IIf(InStr(1, tableNamePart, " ") > 0, InStr(1, tableNamePart, " "), _ IIf(InStr(1, tableNamePart, ";") > 0, InStr(1, tableNamePart, ";"), Len(tableNamePart) + 1))) ' If a space, semicolon, or keyword is found, extract the part before it GetTableNameFromRowSource = Trim(Left(tableNamePart, delimiterIndex - 1)) End Function طيب ما الفروق بين فكرة استاذ موسى وافكاارى المعقدة الطريقتان تقومان بالمهمة المطلوبة ولكن بطرق مختلفة. الافضلية تعتمد على احتياجات البرنامج الخاص بك وتفضيلاتك الشخصية. إليك بعض الملاحظات: الكفاءة والأداء: فكرة الاستاذ @Moosak (GetTableNameFromComboBox) تستخدم تعبيرات شرطية لفحص نوع RowSourceType وتقوم بتفحص الـ "FROM" وتقوم بإزالة الأحرف الزائدة. فكرتى (GetTableNameFromRowSource) تحتوي على عدد قليل من الخطوات وتقوم بفحص كلمة FROM في الاستعلام واستخراج الجدول المرتبط بها. كما تقوم بإزالة أي مفتاح آخر (مثل "ORDER BY") وباقى الكلمات المجدوزة..... الخ نفس الكفاءة ونفس الاداء القابلية للقراءة والصيانة: فكرة الاستاذ @Moosak قد تكون أقل وضوحًا بسبب الاستخدام المكثف للتعبيرات الشرطية. بعكس فكرتى تكون أكثر وضوحًا في فهم الخطوات بسبب استخدام التعليقات والتسميات . المرونة وإعادة الاستخدام: فكرة الاستاذ @Moosak تقوم بكل شيء في نطاق واحد دون استخدام دوال فرعية فكرتى تحتوي على دالة فرعية (GetTableNameFromRowSource) يمكن استخدامها بشكل مستقل لأغراض أخرى إذا لزم الأمر . يعنى ممكن تكون أفكارى معقدة وقت كتابة الكود ولكن أحاول أن أكون ضاحب نظرة مستقبلية عند محاولة الانتفاع منه . وفى الاخير يا والدى الحبيب من الجيد أن تختار الدالة التي تلبي أفضل احتياجات مشروعك وتفضيلاتك الشخصية . ولكن انا لو مكانك اعبى المكتبة بمرفق الاستاذ @Moosak لانه الاجمل