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

ما نسيتك يا صديقي ، ولكن صدقاً انشغلت في العمل من جهة ، ومن جهة أخرى عندي بعض الطلبات لأخوة في المنتدى وفي جروب الواتس أب 🥺

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

الخبير الفاضل والمعلم المبدع Foksh شـــكرا لك

أخي @صالح الصالحي ، جزاك الله خير على ردك وتوضيحاتك التي ذكرتها ، ولكن لكثرة الحقول وتعدد العلاقات مع وبين الجداول وجدت ان الموضوع ليس بالهين 😇 وقد نستعين سويةً بخبرات أساتذة أتعلم منهم 🤗

بعد التجربة وجدت ان عملية الحفظ تأخذ وقتا حتى تظهر الرسالة اليك التعديل النهائي وارجو المعذرة لانني كنت في العمل وعملت الكود على عجالة ولم اجربه كفايه. MyArchfa.accdb

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

تفضل جرب هدا Public Sub Filter_data() Dim arrayCriteria(), _ desWS As Worksheet, _ lo As ListObject, _ rng As Range, _ Cpt As Long, _ i As Long Set lo = Range("Clé").ListObject Cpt = lo.ListRows.Count ReDim arrayCriteria(Cpt) For i = 1 To Cpt arrayCriteria(i) = CStr(lo.DataBodyRange.Cells(i, 1)) Next i Set rng = Range("T_data"): Set desWS = Sheets("Feuil2") If WorksheetFunction.CountA(lo.DataBodyRange) = 0 Then MsgBox "المرجوا ادخال معيار الفلترة": Exit Sub With rng.ListObject Application.ScreenUpdating = False If .ShowAutoFilter Then .AutoFilter.ShowAllData .Range.AutoFilter field:=5, Criteria1:=arrayCriteria, Operator:=xlFilterValues If (rng.Rows.Count > 1) Then desWS.Range("d13:k" & Rows.Count).Clear .AutoFilter.Range.Offset(1).SpecialCells(xlVisible).Copy desWS.[D13] [T_data].AutoFilter End If End With Application.ScreenUpdating = True smr.xlsm

تفضل اخي الكريم التعديل شكرا للاخ @Foksh على الملاحظة . MyArchfa.accdb

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

أخي @aldaynee ، دون مرفق لا اعتقد أنك ستجد حل شافي ، ولكن انظر لهذا المرفق قمت بنسخ نص من ويكيبيديا يتجاوز أعتقد الـ 500 حرف ويظهر النص في التقرير بشكل كامل . عل المشكلة في نسخة الأوفيس !!! أو ارسل ملف يضم المشكلة Long Text.accdb

رقم 15 هو يوم بداية الاسبوع كما جاء في طلبك اليك المرفق التالي ربما تتضح اليك الفكرة لتساعدك على تحديد الرقم المناسب لك او قم بكتابة تاريخ من اختيارك في الخلية A2 مثلا وجرب استخدام شيئ كهدا Sub TEST() Dim d As Integer d = InputBox("المرجوا ادخال رقم بداية الاسبوع ") Range("C2").Formula = "=weeknum(a2," & d & ")" End Sub '******************************* Sub TEST2() Dim week As Date 'خلية التاريخ week = Range("a2") 'هنا تم تحديد يوم الجمعة كاول يوم في الاسبوع d = 15 st = Application.WeekNum(week, d) MsgBox "رقم الاسبوع هو :" & " " & st, vbInformation End Sub بالتوفيق .... WEEKDAY.xlsx

ارجو أخي الكريم @صالح الصالحي ان تقوم بالغاء افضل إجابة ، واستخدامها لحين ان تجد الإجابة الصحيحة أياً كان مقدمها ، هذا أولاً ثانياً ، التزاماً بقواعد المنتدى ادراج بعض البيانات التي ترغب بانتاج البحث والتقارير عنها ، وليس ارفاق ملف فارغ وكأنك تريد ممن يقدم المساعدة أن يملأه ثالثاً ، للوصول لحلول لمشكلتك :- لا تستخدم أسماء عربية في مسميات الحقول . لا تستعمل المسافات بين الأسماء . لا تستعمل اسماء حقول محجوزة للبرنامج مثل ( Name,Date,To,From ..... إلخ ) لا تستعمل رموز ( #، @،$،& .... إلخ ) في مسميات الحقول . لا تستعمل الأرقام في أسماء حقول الجداول أو تبدأ بها . قواعد المشاركة بمنتدي أوفيسنا

اعتذر عن الانقطاع لظروف مرضية ان شاء الله سوف نبدأ فى الاستمرار تباعا بامر الله

لتصميم الشاشة الرئيسية وسهولة التحكم فىيها تم اضافة جدول جديد باسم 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

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

البيانات الرئيسية والتى نريد تحضيرها مرة واحدة فقط عند بدء التطيق لنتمكن من استخدامها فى زوايا التطبيق المختلفة على سبيل المثال وليس الحصر نريد اسم الشركة دائما فى كل التقارير مثلا عند تحقق شرط معين بيانات الاتصال بالمصمم لعمل ذلك نقوم ببناء جدول ليكون اسمه 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