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

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

استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل فى المشاركة السابقة كان الروتين لابد من تمرير له -مربع السرد مصدر البيانات -اسم حقل الشرط -اسم الحقل الذى يحوى القيم المراد التحديث مثلها --------------------------------------------------------------------------------------- فى هذاالتعديل اضفت اسم الجدول واسم الحقل المراد تحديثه كذلك ليكون الروتين عام بذلك لن نحتاج الى تعديل اى شئ فى بناء الكود مستقبلا مهما اختلفت الاسماء للجداول والحقول بذلك يكون متاح لحضرتك كل الافكار فتدلل واختر منها ما يتماشى مع رغباتك ويلائم احتياجاتك وافكارك تحديث جديد لتمرير اسم الجدول كذلك للروتين على ان يكون الاستدعاء UpdateTableRecordsFromComboBox "Table1", "text1", Me.Combo0, "id", "sName" Sub UpdateTableRecordsFromComboBox(TableName As String, _ FieldToUpdate As String, _ TargetComboBox As ComboBox, _ ConditionFieldName As String, _ UpdateValueFieldName As String) Dim db As DAO.Database Dim strSQL As String Dim intConditionFieldValue As Integer Dim strUpdateFieldValue As String Dim rsCombo As DAO.Recordset ' Check if the tableName is specified If Nz(TableName, "") = "" Then MsgBox "Please specify the table name.", vbExclamation: Exit Sub ' Check if the FieldToUpdate is specified If Nz(FieldToUpdate, "") = "" Then MsgBox "Please specify the target field name to update.", vbExclamation: Exit Sub ' Check if the targetComboBox is valid If TargetComboBox Is Nothing Then MsgBox "Please select a valid ComboBox.": Exit Sub ' Check if the conditionField is specified If Nz(ConditionFieldName, "") = "Please specify the condition field name." Then MsgBox "": Exit Sub ' Check if the updateValueField is specified If Nz(UpdateValueFieldName, "") = "" Then MsgBox "Please specify the update field name.": Exit Sub ' Open the database Set db = CurrentDb ' Open a recordset for the values in targetComboBox Set rsCombo = db.OpenRecordset(TargetComboBox.RowSource, dbOpenSnapshot) ' Disable the error handling temporarily On Error Resume Next ' Loop through each record in targetComboBox Do Until rsCombo.EOF ' Get the value from the current record in targetComboBox intConditionFieldValue = rsCombo.Fields(ConditionFieldName).Value strUpdateFieldValue = rsCombo.Fields(UpdateValueFieldName).Value ' Construct the SQL update statement strSQL = "UPDATE " & TableName & " " & _ "SET " & FieldToUpdate & "= '" & Nz(strUpdateFieldValue, "") & "' " & _ "WHERE " & TableName & "." & FieldToUpdate & "= '" & intConditionFieldValue & "';" ' Execute the query db.Execute strSQL ' Check for errors If Err.Number <> 0 Then ' Clear the error Err.Clear ' Move to the next record without processing the error Resume Next End If ' Move to the next record in targetComboBox rsCombo.MoveNext Loop ' Enable the normal error handling On Error GoTo 0 ' Close the recordset and the database rsCombo.Close Set rsCombo = Nothing Set db = Nothing End Sub DatabaseUp4.rar

العفو منكم استاذى الجليل ومعلمى القدير و والدى الحبيب انا وكل ما أملك ملك يمينك وتحت امرك وهذه بضاعتكم وترد اليكم ما انا الا طويلب العلم الذى يتعلم منكم وعلى ايديكم وكل الفضل يعود لكم بعد رب العزة سبحانه وتعالى ممكن عمل روتين عام ليتم استدعاءه من خلال optional وذلك لارجاع اسم مربع النص الى الروتين كى لا تتم كتابة الاكواد كثيرا ان تعددت مربعات النص

العفو منكم استاذى الجليل ومعلمى القدير طيب ممكن نعمل الكود الثانى بالشكل الاتى ليتم التحديث على الجميع جملة مرة واحدة وبدون اختيار اى قيمة من مربع التحرير ولكن سوف يكون ذلك التحديث بالاعتماد على القيم من مربع السرد مهما كان مصدر بياناته Dim db As DAO.Database Dim strSQL As String Dim intcomboValue As Integer Dim strcomboValue As String Dim rsCombo As DAO.Recordset ' Open the database Set db = CurrentDb ' Open a recordset for the values in Combo0 Set rsCombo = db.OpenRecordset(Me.Combo0.RowSource, dbOpenSnapshot) ' Disable the error handling temporarily On Error Resume Next ' Loop through each record in Combo0 Do Until rsCombo.EOF ' Get the value from the current record in Combo0 intcomboValue = rsCombo.Fields("id").Value strcomboValue = rsCombo.Fields("sName").Value ' Construct the SQL update statement strSQL = "UPDATE Table1 " & _ "SET text1 = '" & Nz(strcomboValue, "") & "' " & _ "WHERE Table1.text1 = '" & intcomboValue & "';" ' Execute the query db.Execute strSQL ' Check for errors If Err.Number <> 0 Then ' Clear the error Err.Clear ' Move to the next record without processing the error Resume Next End If ' Move to the next record in Combo0 rsCombo.MoveNext Loop ' Enable the normal error handling On Error GoTo 0 ' Close the recordset and the database rsCombo.Close Set rsCombo = Nothing Set db = Nothing الان الاعتماد على مربع السرد مهما كان مصدر بياناته من خلال السطر Set rsCombo = db.OpenRecordset(Me.Combo0.RowSource, dbOpenSnapshot)

وعليكم السلام ورحمة الله وبركاته أرجو أن يكون الحل مناسباً يمكنك وضع المعادلة التالية في B2 ووضع معادلة ثانية في C2 كما يلي: B2: =IF(A2="";"";VLOOKUP(A2;Table1;2;0)) C2: =IF([رقم الموظف]="";"";LOOKUP(2;1/(Table1[[الاسم ]]=[[الاسم ]]);Table1[تاريخ اخر اجازة])) بالتوفيق إن شاء الله Book144.xlsm

بارك الله فيك استاذ ورئيس قسم @محمد هشام.

تفضل اخي تم وضع الكود في المكان المناسب تلوين.xlsm

بارك الله فيك استاذى الكريم هو المطلوب جعله الله فى ميزان حسناتك

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

بارك الله بك @Foksh نعم صحيح هذا ما اريد واستغنيت عن المديول والماكرو ,, شكرا لك جزيل الشكر ,, انت والقائمين على هذا الموقع المميز انا عكست اشارة > لتبقى كل القيم محفوظه .

ما شاء الله لا قوة الا بالله هكذا العبقرية في الاحتراف والا فلا سبحان الذي اعطاك الملكة والبديهة البرمجية لا املك الا الدعاء لك .. بأن يحفظك الله في اهلك وولدك ومالك وصحتك ، وان يرزقك من حيث لا تحتسب وأسأل الله الكريم ان يجعل ما تبذله من وقت وجهد .. عزا لك في الدنيا وراحة بال ، ورفعة لك في آخرتك

انتظر وان شاء الله ابشـر بالخيـر

صراحة لم استوعب طلبك جيدا لاكن جرب وضع هدا الكود في module Option Explicit Public Sub ColourChange() Dim Clé As Range For Each Clé In ActiveWorkbook.ActiveSheet.Range("F5:F36") Application.ScreenUpdating = False If Not IsError(Clé) Then With Clé .Interior.ColorIndex = xlColorIndexNone: .Font.Color = RGB(0, 0, 0) Select Case .Value2 Case "اخضر", "أخضر" .Interior.Color = RGB(0, 204, 0): .Font.Color = RGB(0, 204, 0) Case "ازرق", "أزرق" .Interior.Color = RGB(0, 0, 255): .Font.Color = RGB(0, 0, 255) Case "اصفر", "أصفر" .Interior.Color = RGB(255, 255, 0): .Font.Color = RGB(255, 255, 0) Case "احمر", "أحمر" .Interior.Color = RGB(255, 0, 0): .Font.Color = RGB(255, 0, 0) End Select End With End If Next Application.ScreenUpdating = True End Sub وفي حدث ورقة شهادات ضع الرمز التالي ' على حسب احتياجاتك Private Sub Worksheet_Activate() ColourChange End Sub ' او Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("F5:F36")) Is Nothing Then If Target.Cells.Value = Empty Then Exit Sub Aplication.EnableEvents = False Call ColourChange Application.EnableEvents = True On Error GoTo 0 End If End Sub

ومن قال انه يكفينى انا ؟! ومن قال اننى فى حل اعتذر عن التأخير كنت صائم بل روعة حياتنا هم اساتذتنا العظماء الذين اناروا افكارنا شكرا لكم استاذى الجليل و معلمى القدير و والدى الحبيب استاذ @ابوخليل سعادة الحياة أن تكون بجانبك وتساندك روح طيبة وكريمة تمنحك وتهديك الفرح والسرور وتدخل على نفوس من حولها الفرح و السعادة ولا أزكيكم على الله وكل اساتذتنا المبجلين كل كلمات ومعان الشكر والعرفان بالجميل لا تكفيكم وتوفيكم قدر حقكم بارك الله لكم فى عمركم وفى علمكم و عملكم واهلكم وأسال الله تعالى لكم سعادة الدارين وان يزيدكم من فضله كما تدخلون السرور على قلوب طلاب العلم دائما تكثرون من العطاء وبكل سخاء دون كلل ولا ملل احسن الله اليكم كما تحسنون الى طلاب العلم دائما ----- اتفضل استاذى الجليل ومعلمى القدير ووالدى الحبيب اولا الدالة الاتية لاحضار اسماء الحقول Function GetFieldNameFromRowSource(ComboRowSource As String, columnIndex As Integer) As String Dim columns As Variant Dim columnName As String ' Split the RowSource to get the column names columns = Split(Mid(ComboRowSource, InStr(ComboRowSource, "SELECT") + Len("SELECT")), ",") ' Extract the column name from the specified index columnName = Trim(Split(Split(columns(columnIndex - 1), "AS")(0), ".")(1)) ' Return the column name GetFieldNameFromRowSource = columnName End Function وهذه الدالة التى يتم التحديث من خلالها Sub GetComboBoxNameAndUpdateTableRecords(frm As Form) Dim ctrl As Control Dim ComboRowSource As String Dim FldData As String Dim FldID As String Dim strSQL As String ' Loop through all controls on the form For Each ctrl In frm.Controls ' Check if the control is a TextBox or a ComboBox If TypeOf ctrl Is comboBox Then ' Perform your custom action for each control ' For example, print the name and set a default value If Not ctrl Is Nothing Then ' Debug.Print "Control Name: " & ctrl.Name ComboRowSource = ctrl.rowSource FldID = GetFieldNameFromRowSource(ComboRowSource, 1) FldData = GetFieldNameFromRowSource(ComboRowSource, 2) Dim varConditionFieldValue As Variant Dim varUpdateFieldValue As Variant ' Open the database Dim db As DAO.Database Set db = CurrentDb ' Verify RowSource If Len(ComboRowSource) = 0 Then ' Debug.Print "RowSource is empty for control " & ctrl.Name Exit For End If ' Open a recordset for the values in targetComboBox Dim rsCombo As DAO.Recordset Set rsCombo = db.OpenRecordset(ComboRowSource, dbOpenSnapshot) ' Verify Recordset If rsCombo.EOF Then ' Debug.Print "Recordset is empty for control " & ctrl.Name rsCombo.Close Set rsCombo = Nothing Set db = Nothing Exit For End If Do Until rsCombo.EOF Dim TableName As String Dim FieldToUpdate As String Dim ConditionFieldNameTable As Variant Dim ConditionComboBoxFieldNameTable As Variant ' Get the value from the current record in targetComboBox varConditionFieldValue = rsCombo.Fields(FldID).Value varUpdateFieldValue = rsCombo.Fields(FldData).Value ' Table and Field Names TableName = "Table1" FieldToUpdate = "textNm" ConditionFieldNameTable = "frmNm" ConditionComboBoxFieldNameTable = "FieldNm" ' Construct the SQL update statement strSQL = "UPDATE " & TableName & " " & _ "SET " & FieldToUpdate & "='" & Nz(varUpdateFieldValue, "") & "' " & _ "WHERE " & TableName & "." & ConditionComboBoxFieldNameTable & "= '" & ctrl.Name & "' AND " & _ TableName & "." & ConditionFieldNameTable & "= '" & Nz(frm.Name, "") & "' AND " & _ TableName & "." & FieldToUpdate & "= '" & varConditionFieldValue & "';" ' Debug.Print strSQL ' Execute the query db.Execute strSQL, dbFailOnError rsCombo.MoveNext Loop ' Close the recordset and the database rsCombo.Close Set rsCombo = Nothing Set db = Nothing End If End If Next ctrl End Sub ونستدعى الدالة فقط من خلال GetComboBoxNameAndUpdateTableRecords Me هى سوف تقوم بكل شئ بالنيابة عنك لا تقلق منها يا معلملى هى دالة ذكية ليست مثلى طبعا يا استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل ان اردت اضافة هذه المعاملات ( parameters ) الى رأس الدالة لتكتبها عند الاستدعاء ان كانت متغيرة فلا بأس بذلك سبق التعامل معها فى الامثلة السابقة ' Table and Field Names TableName = "Table1" FieldToUpdate = "textNm" ConditionFieldNameTable = "frmNm" ConditionComboBoxFieldNameTable = "FieldNm" بــــــس خلاص أخيرا خلصت الواجب الحمد لله واخيرا المرفق DatabaseUp7.rar

ولا اروع ولا اجمل .. ويعمل بشكل صحيح ودقيق وعلى طريقتك حبيبنا فيه حاجة صغننة .. سأحاول ان استطعت ان لم تسبقني وهي تصور ان النموذج يشتمل على 10 مربعات او اكثر او اقل .. وهنا يلزمني كتابة عشرة اسطر فافكر اعمل متغير ودوران يأخذ اسماء مربعات التحرير ... وفي الوقت نفسه يأخذ قيمة مربع التحرير وقيمة العمود الثاني من هذا السطر Set rsCombo = db.OpenRecordset(targetComboBox.RowSource, dbOpenSnapshot) اخي الغالي ابو جودي انت في الف حل فلا تشغل نفسك .. يكفيني النقطة التي اوصلتني اليها ، جزاؤك واجرك على الله

استاذى الجليل ومعلمى القدير و والدلى الحبيب الاستاذ @ابوخليل اعتذر انا فى العمل الان لذلك اعتذر عن التأخير فى الرد وهذا التعديل الاخير بناء على رغباتكم اتمنى ان شاء الله أن يكون ملائما ومناسبا بصراحة مش قادر اسهل التعامل مع الدالة باستدعائها باكتر من ذلك اعرف ان كود الاستدعاء اصبح كبير جدا ويحتوى على العديد من المعاملات parameters Sub UpdateTableRecordsFromComboBox(TableName As String, _ FieldToUpdate As String, _ ConditionFieldNameTable As String, _ ConditionComboBoxFieldNameTable As String, _ frm As Form, _ TargetComboBox As ComboBox, _ ConditionFieldName As String, _ UpdateValueFieldName As String) Dim db As DAO.Database Dim strSQL As String Dim varConditionFieldValue As Variant Dim varUpdateFieldValue As Variant Dim rsCombo As DAO.Recordset ' Check if the tableName is specified If Nz(TableName, "") = "" Then MsgBox "Please specify the table name.", vbExclamation Exit Sub End If ' Check if the FieldToUpdate is specified If Nz(FieldToUpdate, "") = "" Then MsgBox "Please specify the target field name to update.", vbExclamation Exit Sub End If ' Check if the targetComboBox is valid If TargetComboBox Is Nothing Then MsgBox "Please select a valid ComboBox.", vbExclamation Exit Sub End If ' Check if the conditionFieldTable is specified If Nz(ConditionFieldNameTable, "") = "" Then MsgBox "Please specify the condition field name for the table.", vbExclamation Exit Sub End If ' Check if the conditionField is specified If Nz(ConditionFieldName, "") = "" Then MsgBox "Please specify the condition field name.", vbExclamation Exit Sub End If ' Check if the updateValueField is specified If Nz(UpdateValueFieldName, "") = "" Then MsgBox "Please specify the update field name.", vbExclamation Exit Sub End If ' Check if the ConditionComboBoxFieldNameTable is specified If Nz(ConditionComboBoxFieldNameTable, "") = "" Then MsgBox "Please specify the condition ComboBox field name for the table.", vbExclamation Exit Sub End If ' Open the database Set db = CurrentDb ' Open a recordset for the values in targetComboBox Set rsCombo = db.OpenRecordset(TargetComboBox.RowSource, dbOpenSnapshot) ' Disable the error handling temporarily On Error Resume Next ' Loop through each record in targetComboBox Do Until rsCombo.EOF ' Get the value from the current record in targetComboBox varConditionFieldValue = rsCombo.Fields(ConditionFieldName).Value varUpdateFieldValue = rsCombo.Fields(UpdateValueFieldName).Value ' Construct the SQL update statement strSQL = "UPDATE " & TableName & " " & _ "SET " & FieldToUpdate & "='" & Nz(varUpdateFieldValue, "") & "' " & _ "WHERE " & TableName & "." & ConditionComboBoxFieldNameTable & "= '" & TargetComboBox.Name & "' AND " & _ TableName & "." & ConditionFieldNameTable & "= '" & Nz(frm.Name, "") & "' AND " & _ TableName & "." & FieldToUpdate & "= '" & varConditionFieldValue & "';" ' Debugging information ' Dbug.Print "SQL Statement: " & strSQL ' Execute the query db.Execute strSQL ' Check for errors If Err.Number <> 0 Then ' Clear the error Err.Clear ' Move to the next record without processing the error Resume Next End If ' Move to the next record in targetComboBox rsCombo.MoveNext Loop ' Enable the normal error handling On Error GoTo 0 ' Close the recordset and the database rsCombo.Close Set rsCombo = Nothing Set db = Nothing strSQL = vbNullString varConditionFieldValue = vbNullString varUpdateFieldValue = vbNullString End Sub المرفق.. DatabaseUp6.rar

تفضل أخي الكريم هذا التعديل البسيط ، تم الأخذ بعين الإعتبار الإضافة أو التعديل ، وستلاحظ ذلك أثناء التطبيق . تم الاستغناء عن المديول القديم والماكرو ايضاً . 88.accdb

مشاركة مع الأستاذ @محمد السيسي تفضل أخي @moho58 ، كان السبب أعتقد أن الكود لم يقوم بإنشاء المجلد Backup من تلقاء نفسه ، تم التعديل وحل المشكلة . هذا المرفق تم تعديله . Backup 2024.zip

انت طول الليل جالس شغال .. وانا تركتك ورحت انام .. فاعذرني حكم السن .. لا يمكنني مجاراة الشباب ما شاء الله لا قوة الا بالله .. اختصرت علي الكثير جزاك الله خيرا -------------------------------------------------------------------------------------------------- الآن دعني اخبرك الحكاية كما يقولون من طق طق الى .... القيمة الرقمية في الجدول نأخذها من ذاكرة اكسس ... كيف ؟ اشرح .. هات زيادة في التفصيل يوجد في المشروع روتين يسجل اي تغيير يحدث على الحقول داخل النماذج الحقول النصية لا اشكال فيها المشكلة فقط في مربعات التحرير فجميع قيم مربعات التحرير في المشروع رقمية فالروتين قبل تحديث النموذج يأخذ قيمة مربعات التحرير السابقة وقيمتها الحالية قيمته الحالية لا اشكال فيها حيث يمكنني التعامل مع العنصر الحالي واستخراج قيمة العمود الثاني النصية ولكن المشكلة في القيمة السابقة فهي عبارة عن قيمة فقط في ذاكرة أكس وليس لها اي ارتباط فأنا الآن اريد ترجمة الرقم الى قيمته النصية بناء على (النموذج + مربع التحرير الخاص به) هذه كل الحكاية ----------------------------------------------------------------------------------------------------------------------- طيب نأتي للمفيد انت وصلت الى مرحلة متقدمة جدا لا يمكن الوصول اليها بسهولة .. وبقي تكة .. لعلها لا تصعب عليك انا عدلت على الجدول في المثال كما هو موجود عندي في المشروع .. حين تطلع عليه ستفهم المطلوب المطلوب تحديث الحقل بناء على اسم النموذج واسم الحقل الموجودات ضمن السجل طبعا اضفت نموذج آخر ومربعات تحرير اخرى اعتقد المعيار في الروتين سيكون بحاجة الى اسم النموذج ، حيث ان الكود سيتم تشغيله من النموذج النشط ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, DatabaseUp5.rar

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

حاضرين .تفضل طلبك الثاني . اذا كان الطلب كما طلبت من فضلك سددة بأفضل اجابة . DD442.rar

تم إصلاح الخلل وعمل عدة تنقيحات: حضور وإنصراف_05.xlsb

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

السلام عليكم و رحمة الله و بركاتة جعل الله يوم الجمعه لك نوراً، وظهره سروراً، وعصره استبشاراً، ومغربه غفراناً، وجعل لك دعوة لا ترد ووهبك رزقاً لا يعد وفتح لك باباً إلى الجنة لا يسد.

Private Sub Worksheet_Change(ByVal Target As Range) Dim Lr As Long Set V1 = Sheet4: Set V2 = Sheet10: Set V3 = Sheet11 Lr = V1.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row Application.ScreenUpdating = False V2.Range("F9:F" & Lr).Value = V1.Range("F9:F" & Lr).Value V3.Range("F9:F" & Lr).Value = V1.Range("L9:L" & Lr).Value V3.Range("H9:H" & Lr).Value = V1.Range("O9:O" & Lr).Value Application.ScreenUpdating = True End Sub

الاخ الكريم matrix_0004 لا اعرف لماذا لم يعمل الكود معك فهو يعمل عندي تمام أنظر في المرفقات ستجد هناك طريقتين الاولى في النموذج Categories والثانية في النموذج f1 noRecords.zip