عبدالله بشير عبدالله

اقفل الملف وافتحه من جديد وادخل مباشرة الى References ستجدها مفعلة

تعديل بسيط اي كلمة يمين في الشرح غيرها يسار

تفضل الشرح بالتفصيل الشرح استعنت بالذكاء الاصطناعي الهدف من هذا الكود هو البحث عن اسم معين في ورقة عمل تسمى “السجل” وعند العثور عليه، نسخ مجموعة من البيانات المرتبطة بهذا الاسم إلى ورقة عمل أخرى تسمى “استدعاء”. إليك الخطوات الرئيسية التي يقوم بها الكود لتحقيق هذا الهدف: مراقبة التغييرات في الخلية B6 في ورقة “استدعاء”. البحث عن الاسم المدخل في الخلية B6 داخل العمود B في ورقة “السجل”. نسخ البيانات المرتبطة بالاسم الموجود في ورقة “السجل” إلى مواقع محددة في ورقة “استدعاء”. إذا تم العثور على الاسم، يتم نسخ البيانات إلى الصفوف 9، 12، 15، و18 في ورقة “استدعاء”. إذا لم يتم العثور على الاسم، يتم عرض رسالة تفيد بأن الاسم غير موجود في السجل If Not foundCell Is Nothing Then هذا السطر يتحقق مما إذا كانت الخلية foundCell تحتوي على قيمة أم لا. إذا كانت foundCell تحتوي على قيمة، فهذا يعني أن الاسم الذي تم البحث عنه قد تم العثور عليه في العمود B في الورقة “السجل”. إذا لم يتم العثور على الاسم، فإن foundCell ستكون Nothing. نسخ البيانات إلى الصف 9: data = wsSource.Range(foundCell.Offset(0, 1), foundCell.Offset(0, 10)).Value wsTarget.Range("A9:I9").Value = data foundCell.Offset(0, 1) تعني الانتقال من الخلية التي تم العثور عليها بمقدار عمود واحد إلى اليمين. foundCell.Offset(0, 10) تعني الانتقال من الخلية التي تم العثور عليها بمقدار 10 أعمدة إلى اليمين. يتم نسخ البيانات من العمود الثاني إلى العمود الحادي عشر في الصف الذي تم العثور فيه على الاسم إلى الصف 9 في الورقة “استدعاء”. نسخ البيانات إلى الصف 12: data = wsSource.Range(foundCell.Offset(0, 10), foundCell.Offset(0, 19)).Value wsTarget.Range("A12:I12").Value = data foundCell.Offset(0, 10) تعني الانتقال من الخلية التي تم العثور عليها بمقدار 10 أعمدة إلى اليمين. foundCell.Offset(0, 19) تعني الانتقال من الخلية التي تم العثور عليها بمقدار 19 عمودًا إلى اليمين. يتم نسخ البيانات من العمود الحادي عشر إلى العمود العشرين في الصف الذي تم العثور فيه على الاسم إلى الصف 12 في الورقة “استدعاء”. نسخ البيانات إلى الصف 15: data = wsSource.Range(foundCell.Offset(0, 19), foundCell.Offset(0, 28)).Value wsTarget.Range("A15:I15").Value = data foundCell.Offset(0, 19) تعني الانتقال من الخلية التي تم العثور عليها بمقدار 19 عمودًا إلى اليمين. foundCell.Offset(0, 28) تعني الانتقال من الخلية التي تم العثور عليها بمقدار 28 عمودًا إلى اليمين. يتم نسخ البيانات من العمود العشرين إلى العمود التاسع والعشرين في الصف الذي تم العثور فيه على الاسم إلى الصف 15 في الورقة “استدعاء”. نسخ البيانات إلى الصف 18: data = wsSource.Range(foundCell.Offset(0, 28), foundCell.Offset(0, 38)).Value wsTarget.Range("A18:I18").Value = data foundCell.Offset(0, 28) تعني الانتقال من الخلية التي تم العثور عليها بمقدار 28 عمودًا إلى اليمين. foundCell.Offset(0, 38) تعني الانتقال من الخلية التي تم العثور عليها بمقدار 38 عمودًا إلى اليمين. يتم نسخ البيانات من العمود التاسع والعشرين إلى العمود الثامن والثلاثين في الصف الذي تم العثور فيه على الاسم إلى الصف 18 في الورقة “استدعاء”. إذا لم يتم العثور على الاسم: Else MsgBox "الاسم غير موجود في السجل." End If إذا لم يتم العثور على الاسم، يتم عرض رسالة تفيد بأن الاسم غير موجود في السجل

وعليكم السلام ورحمة الله وبركاته الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$6" Then Application.ScreenUpdating = False Dim wsSource As Worksheet Dim wsTarget As Worksheet Dim nameToFind As String Dim foundCell As Range Dim data As Variant Set wsSource = ThisWorkbook.Sheets("السجل") Set wsTarget = ThisWorkbook.Sheets("استدعاء") nameToFind = wsTarget.Range("B6").Value Set foundCell = wsSource.Range("B:B").Find(What:=nameToFind, LookIn:=xlValues, LookAt:=xlWhole) If Not foundCell Is Nothing Then data = wsSource.Range(foundCell.Offset(0, 1), foundCell.Offset(0, 10)).Value wsTarget.Range("A9:I9").Value = data data = wsSource.Range(foundCell.Offset(0, 10), foundCell.Offset(0, 19)).Value wsTarget.Range("A12:I12").Value = data data = wsSource.Range(foundCell.Offset(0, 19), foundCell.Offset(0, 28)).Value wsTarget.Range("A15:I15").Value = data data = wsSource.Range(foundCell.Offset(0, 28), foundCell.Offset(0, 38)).Value wsTarget.Range("A18:I18").Value = data Else MsgBox "الاسم غير موجود في السجل." End If Application.ScreenUpdating = True End If End Sub الملف كود استدعاء بيانات1.xlsm

وعليكم السلام ورحمة الله وبركاته الكود Sub CountIfToColumnH() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Set ws = ThisWorkbook.Sheets("Sheet1") lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row For i = 2 To lastRow ws.Cells(i, "H").Value = Application.WorksheetFunction.CountIf(ws.Range("G$2:G" & i), ws.Cells(i, "G").Value) Next i End Sub الملف TEST COUNTIF.xlsb

السلام عليكم ورحمة الله وبركاتة اليك الحل المعادلة =IF(I2="";"";AGGREGATE(14;6;E$2:E$100/(F$2:F$100=I2);1)) الملف Book2.xlsx

وعليكم السلام ورحمة الله وبركاته ارجو كتابة النتائج المتوقعة في صفحة تقرير شامل ولو خمسة صفوف حتى يتم بناء الكود على النتائج المتوقعة وخاصة ان الصفحتان 1 و2 تختلفان في اغلب البيانات

وعليكم السلام ورحمة الله وبركاته الزر الاخير الحذف ملغي لان الز رين انشاء صفحة وزر فصل المرتب يقومان بحذف الصفحات قبل انشائها في كل ضغظة على الزر && الاستعلام باي كلمة من الجدول وعند الضغظ على زراستغلام ينقلك الى الكلمة التي تبحث عنها مع تلوينها وتكون كتابة كلمة البحث في الخلية B1 الموظفين.xlsb

بارك الله فيك استاذنا الفاضل محمد هشام على الافادة (وَقُل رَّبِّ زِدْنِي عِلْمًا)

وعليكم السلام ورحمة الله تعالى وبركاته بعد اذن استاذنا الفاضل محمد هشام ,حل لكل الخيارات وان لم يطلبها صاحب الموضوع الكود Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim wsDashboard As Worksheet Dim wsMain As Worksheet Dim rng As Range Dim count As Long Dim filterValue As String Set wsDashboard = ThisWorkbook.Sheets("لوحة المعلومات") Set wsMain = ThisWorkbook.Sheets("الرئيسية") Select Case Target.Address Case wsDashboard.Range("C17").Address filterValue = "تحت الاجراء" Case wsDashboard.Range("D17").Address filterValue = "في الانتظار" Case wsDashboard.Range("F17").Address filterValue = "مكتمل" Case wsDashboard.Range("G17").Address filterValue = "محالة" Case wsDashboard.Range("H17").Address filterValue = "معلق / مؤجل" Case Else Exit Sub End Select wsMain.Activate If wsMain.AutoFilterMode Then wsMain.AutoFilterMode = False End If wsMain.Range("A1").AutoFilter Field:=10, Criteria1:=filterValue Set rng = wsMain.Range("J2:J" & wsMain.Cells(wsMain.Rows.count, "J").End(xlUp).Row) count = Application.WorksheetFunction.CountIf(rng, filterValue) If count > 0 Then MsgBox "عدد الطلبات التي تحتوي على '" & filterValue & "' هو: " & count Else MsgBox "لا توجد طلبات تحتوي على '" & filterValue & "'." End If End Sub الملف ملف ادارة طلبات1.xlsb

إذا كنت ترغب في زيادة عدد المراتب، لا تحتاج إلى تعديل الكود نفسه. الكود مصمم للتعامل مع أي عدد من أوراق العمل التي تبدأ بكلمة “المرتبة”. الجملة الشرطية If Left(ws.Name, 7) = "المرتبة" Then تعني التحقق مما إذا كانت أول سبعة أحرف من اسم ورقة العمل (ws.Name) تساوي كلمة “المرتبة”. شرح الجملة الشرطية بالتفصيل: Left(ws.Name, 7): هذه الدالة تأخذ أول سبعة أحرف من اسم ورقة العمل. على سبيل المثال، إذا كان اسم الورقة هو “المرتبة 1”، فإن Left(ws.Name, 7) ستعيد “المرتبة”. = “المرتبة”: هذه هي المقارنة التي تتحقق مما إذا كانت أول سبعة أحرف تساوي كلمة “المرتبة”. إذا كانت هذه المقارنة صحيحة، فإن الكود داخل الجملة الشرطية سيتم تنفيذه. هذا يعني أن الكود سيعمل فقط على أوراق العمل التي تبدأ أسماؤها بكلمة “المرتبة”. شرح الكود تعطيل تحديث الشاشة والحساب التلقائي: Application.ScreenUpdating = False Application.Calculation = xlCalculationManual يتم تعطيل تحديث الشاشة والحساب التلقائي لتحسين أداء الكود أثناء التنفيذ. التكرار عبر جميع أوراق العمل: For Each ws In ThisWorkbook.Worksheets If Left(ws.Name, 7) = "المرتبة" Then يتم التكرار عبر جميع أوراق العمل في المصنف، ويتم التحقق من أن اسم الورقة يبدأ بكلمة “المرتبة”. الحصول على آخر صف يحتوي على بيانات في العمود “A”: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row التكرار عبر الصفوف من الأسفل إلى الأعلى: For i = lastRow To 2 Step -1 rank = ws.Cells(i, 4).Value يتم التكرار عبر الصفوف من الأسفل إلى الأعلى للحصول على قيمة المرتبة من العمود “D”. التحقق من أن المرتبة لا تتطابق مع اسم الورقة: If rank <> Mid(ws.Name, 9) Then تحديد ورقة العمل المستهدفة بناءً على المرتبة: On Error Resume Next Set targetWs = ThisWorkbook.Worksheets("المرتبة " & rank) On Error GoTo 0 نقل الصف إلى ورقة العمل المستهدفة وحذف الصف من الورقة الأصلية: If Not targetWs Is Nothing Then targetLastRow = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row + 1 targetWs.Rows(targetLastRow).Value = ws.Rows(i).Value ws.Rows(i).Delete End If إعادة تمكين تحديث الشاشة والحساب التلقائي: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic

وعليكم السلام ورحمة الله وبركاته السؤال واضح ولكن وضع فكرة السؤال في كود تحتاج الى وقت لجعل العمل بالملف بطريقة مبسطة وليست معقدة المهم فكرة الكود الحالية بدون اي InputBox ملفك به عدة صفحات كل صفحة بمرتبة معينة اذا اردت تغيير المراتب فمثلا في صفحة مرتبة 6 قم بتغييرعدد من الموظفين الى مراتب جديدة متساوية او مختلفة ثم اذهب الى صفحة مرتبة9 مثلا وقم بتغيير مراتب موظفين الى مراتب اعلى او اقل عند الضغظ على الزر يتم حذف من تغييرت مراتبهم من صفحاتهم وترحليهم كل الى صفحته والكود يرحل من مرتبة اقل الى اعلى او العكس بالمختصر خطوتان الاولى امام اي موظف غير المرتبة المطلوبة لاي عدد تشاءوفي اي صفحة الثانية الضغظ على الزر الكود Sub TransferEmployeeData() Dim ws As Worksheet Dim targetWs As Worksheet Dim lastRow As Long Dim i As Long Dim rank As String Dim targetRank As String Dim targetRow As Long Dim data As Variant Dim targetData As Variant Dim targetLastRow As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For Each ws In ThisWorkbook.Worksheets If Left(ws.Name, 7) = "المرتبة" Then lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row For i = lastRow To 2 Step -1 rank = ws.Cells(i, 4).Value If rank <> Mid(ws.Name, 9) Then On Error Resume Next Set targetWs = ThisWorkbook.Worksheets("المرتبة " & rank) On Error GoTo 0 If Not targetWs Is Nothing Then targetLastRow = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row + 1 targetWs.Rows(targetLastRow).Value = ws.Rows(i).Value ws.Rows(i).Delete End If End If Next i End If Next ws Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub الملف ترحيل موظف1 (1).xlsb

وعليكم السلام ورحمة الله وبركاته ارجو ان اكون استوعبت فكرة عمل ملفك قمت بحذف التنسيقات للجداول لان الكود اظهر احطاء الاصناف التي ليس بها مبيعات اي خليتها فارغة لا يرحلها الكود Sub TransferData1() Dim ws As Worksheet Dim lastRow As Long, lastRowJ As Long Dim i As Long Dim found As Range Dim profitMatch As Boolean Dim userResponse As VbMsgBoxResult Set ws = ThisWorkbook.Sheets("ورقة1") lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row userResponse = MsgBox("هل تريد الترحيل؟", vbYesNo + vbQuestion, "تأكيد الترحيل") If userResponse = vbYes Then For i = 5 To lastRow ' التحقق من وجود بيانات في العمود B If ws.Cells(i, "B").Value <> "" Then profitMatch = False lastRowJ = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row Set found = ws.Range("J5:J" & lastRowJ).Find(ws.Cells(i, "A").Value, LookIn:=xlValues, LookAt:=xlWhole) If Not found Is Nothing Then If ws.Cells(i, "E").Value = ws.Cells(found.Row, "N").Value Then ws.Cells(found.Row, "K").Value = ws.Cells(found.Row, "K").Value + ws.Cells(i, "B").Value profitMatch = True End If End If If found Is Nothing Or Not profitMatch Then lastRowJ = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row + 1 ws.Cells(lastRowJ, "J").Value = ws.Cells(i, "A").Value ws.Cells(lastRowJ, "K").Value = ws.Cells(i, "B").Value ws.Cells(lastRowJ, "L").Value = ws.Cells(i, "C").Value ws.Cells(lastRowJ, "M").Value = ws.Cells(i, "D").Value End If End If Next i End If End Sub الملف تقرير مبيعات1.xlsb

بارك الله فيك اخونا الفاضل اتمنى لك كل التوفيق

كم افرحنى واسعدنى دعاؤك لي ولك بالمثل اخونا الفاضل

وعليكم السلام ورحمة الله وبركاته اللهم كن عونا وتصيرالاخواننا في فلسطين كان من المفترض ازالة الحماية من محرر الاكواد وحاولت بكلمة دارفشيان فلم تنجح , على كل حال تم فتح محرر الاكواد بطريقتى الخاصة ولكن جميع الاكواد غير موجودة ما يهمك الكود التالي انقله الى ملفك واربطه بزر الكود Sub ExportToWord1() Dim ws As Worksheet Dim wordApp As Object Dim wordDoc As Object Dim lastRow As Long Dim fileName As String Dim filePath As String Set ws = ThisWorkbook.Sheets("قائمة الأسماء") fileName = ws.Range("E4").Value If fileName = "" Then MsgBox "اسم الملف في الخلية E4 فارغ. يرجى إدخال اسم الملف." Exit Sub End If fileName = Application.WorksheetFunction.Clean(fileName) fileName = Replace(fileName, "/", "") fileName = Replace(fileName, "\", "") fileName = Replace(fileName, ":", "") fileName = Replace(fileName, "*", "") fileName = Replace(fileName, "?", "") fileName = Replace(fileName, """", "") fileName = Replace(fileName, "<", "") fileName = Replace(fileName, ">", "") fileName = Replace(fileName, "|", "") fileName = fileName & ".docx" filePath = ThisWorkbook.Path On Error Resume Next Set wordApp = GetObject(, "Word.Application") If Err.Number <> 0 Then Set wordApp = CreateObject("Word.Application") End If On Error GoTo 0 wordApp.Visible = True Set wordDoc = wordApp.Documents.Add lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row ws.Range("C1:E" & lastRow).Copy wordDoc.Content.Paste wordDoc.SaveAs2 filePath & "\" & fileName wordDoc.Close SaveChanges:=False wordApp.Quit Set wordDoc = Nothing Set wordApp = Nothing MsgBox "تم الترحيل بنجاح إلى الملف: " & fileName End Sub ____________ __________ ________ __________2.xlsm

وعليكم السلام ورحمة الله وبركاته اكتب التاريخ واسم المدرسة ثم اضغظ على زر بحث Sub SearchAndTransfer() Dim wsPlan As Worksheet Dim wsSearch As Worksheet Dim lastRowPlan As Long Dim lastRowSearch As Long Dim i As Long, j As Long Dim searchDate As String Dim searchSchool As String Dim dateFound As Boolean Set wsPlan = ThisWorkbook.Sheets("الخطة") Set wsSearch = ThisWorkbook.Sheets("بحث بالمدرسة") lastRowPlan = wsPlan.Cells(wsPlan.Rows.Count, "B").End(xlUp).Row searchDate = wsSearch.Range("D1").Value searchSchool = wsSearch.Range("C4").Value wsSearch.Rows("9:" & wsSearch.Rows.Count).ClearContents lastRowSearch = 9 For i = 6 To lastRowPlan dateFound = False For j = 5 To 31 ' المدى E5:AE5 يعني الأعمدة من 5 إلى 45 If wsPlan.Cells(5, j).Value = searchDate And wsPlan.Cells(i, j).Value = searchSchool Then dateFound = True Exit For End If Next j If dateFound Then wsSearch.Cells(lastRowSearch, 1).Value = lastRowSearch - 8 wsSearch.Cells(lastRowSearch, 2).Value = wsPlan.Cells(i, 3).Value wsSearch.Cells(lastRowSearch, 3).Value = wsPlan.Cells(i, 4).Value lastRowSearch = lastRowSearch + 1 End If Next i If lastRowSearch = 9 Then MsgBox "لم يتم العثور على أي بيانات ." Else MsgBox "تم نقل البيانات بنجاح!" End If End Sub بحث1.xlsb

وعليكم السلام ورحمة الله وبركاته بواسطة النقر المزدوج على اسم الموظف ثم كتابة المرحلة المنقول اليها يتم نقل الموظف اما نقل مجموعة موظفين ربما يقوم خبراء المنتدى بايجاد حل للموضوع Sub نقل_الموظف_بالنقر_المزدوج(employeeName As String, fromRank As String, toRank As String) Dim wsFrom As Worksheet Dim wsTo As Worksheet Dim found As Range Dim lastRow As Long On Error Resume Next Set wsFrom = ThisWorkbook.Sheets("المرتبة " & fromRank) Set wsTo = ThisWorkbook.Sheets("المرتبة " & toRank) On Error GoTo 0 If wsFrom Is Nothing Or wsTo Is Nothing Then MsgBox "المرتبة غير صحيحة.", vbExclamation Exit Sub End If Set found = wsFrom.Columns(3).Find(What:=employeeName, LookIn:=xlValues, LookAt:=xlWhole) If Not found Is Nothing Then lastRow = wsTo.Cells(wsTo.Rows.Count, 3).End(xlUp).Row + 1 wsTo.Rows(lastRow).Value = wsFrom.Rows(found.Row).Value wsTo.Cells(lastRow, 4).Value = toRank wsFrom.Rows(found.Row).Delete MsgBox "تم نقل الموظف بنجاح.", vbInformation Else MsgBox "لم يتم العثور على الموظف.", vbExclamation End If End Sub ثم في كل صفحة اكتب الكود التالي Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim employeeName As String Dim fromRank As String Dim toRank As String If Target.Column = 3 And Target.Row >= 2 Then employeeName = Target.Value fromRank = Replace(Me.Name, "المرتبة ", "") toRank = InputBox("أدخل المرتبة المنقول إليها للموظف " & employeeName & ":") If toRank = "" Then Exit Sub Call نقل_الموظف_بالنقر_المزدوج(employeeName, fromRank, toRank) Cancel = True End If End Sub ترحيل موظف1.xlsb

كود حفظ نسخة احتياطية من كنوز المنتدى New Microsoft Access Database.accdb

شكرا لك معلمنا محمد صالح الكود بواسطة الذكاء الاصطناعي

وعليكم السلام جرب الملف المرفق Sub SaveWorkbookWithPasswordMonthYear() Dim originalWorkbook As Workbook Dim newWorkbook As Workbook Dim newFilePath As String Dim password As String Dim monthYear As String ' تعيين الملف الأصلي Set originalWorkbook = ThisWorkbook ' الحصول على اسم الشهر والسنة الحاليين monthYear = Format(Date, "mmmm yyyy") ' تحديد مسار الملف الجديد مع اسم الشهر والسنة newFilePath = Application.GetSaveAsFilename(InitialFileName:=monthYear & ".xlsb", FileFilter:="Excel Files (*.xlsb), *.xlsb") ' تعيين كلمة المرور password = InputBox("أدخل كلمة المرور للملف الجديد:") ' حفظ نسخة من الملف الأصلي originalWorkbook.SaveCopyAs newFilePath ' فتح النسخة الجديدة Set newWorkbook = Workbooks.Open(newFilePath) ' حفظ النسخة الجديدة مع كلمة المرور newWorkbook.SaveAs Filename:=newFilePath, password:=password ' إغلاق النسخة الجديدة newWorkbook.Close SaveChanges:=True MsgBox "تم حفظ النسخة الجديدة باسم الشهر والسنة وكلمة المرور بنجاح!" End Sub سلف شهر 8.xlsb

اعدت السؤال مرة اخرى على الذكاء الاصطناعي فاعطاني حل اخر وانقله لك كما هو لتنفيذ ترتيب الأسماء بحيث يبدأ بالذكور أولاً في Microsoft Access، يمكنك استخدام استعلام SQL مخصص. إليك كيفية القيام بذلك: افتح قاعدة البيانات في Access. انتقل إلى علامة التبويب “إنشاء” واختر “استعلام تصميم”. أغلق نافذة “إظهار الجدول”. انتقل إلى علامة التبويب “تصميم” واختر “عرض SQL”. أدخل الكود التالي في نافذة SQL SELECT * FROM جدول_الأسماء ORDER BY IIf(جنس = 'ذكر', 0, 1), اسم; في هذا الكود: جدول_الأسماء هو اسم الجدول الذي يحتوي على الأسماء. جنس هو اسم الحقل الذي يحتوي على الجنس (ذكر أو أنثى). اسم هو اسم الحقل الذي يحتوي على الأسماء. هذا الاستعلام سيقوم بترتيب الأسماء بحيث تظهر الأسماء الذكورية أولاً، ثم الأسماء الأنثوية، وكل منها مرتبة أبجدياً.

قدمت له سؤالك كما هو فاجابنى يمكنك إنشاء استعلام في Microsoft Access يحتوي على عمود محسوب يستخدم دالة لتعديل الأسماء مباشرة في الاستعلام. إليك كيفية القيام بذلك: افتح قاعدة البيانات الخاصة بك في Access. انتقل إلى علامة التبويب “إنشاء” واختر “تصميم استعلام”. أضف الجدول الذي يحتوي على الأسماء التي تريد تعديلها. في عمود جديد في شبكة تصميم الاستعلام، أدخل التعبير التالي: NewName: IIf(Left([YourFieldName], 4) = "عبد ", "عبد" & Mid([YourFieldName], 5), [YourFieldName]) تأكد من استبدال YourFieldName باسم الحقل الفعلي الذي يحتوي على الأسماء. هذا التعبير يقوم بإنشاء عمود جديد يسمى “NewName” في الاستعلام، حيث يتم إزالة المسافة بين “عبد” وبقية الاسم إذا كانت موجودة. يمكنك الآن استخدام هذا العمود الجديد للتصفية والبحث في الاستعلام. انتهت الاجابة

معلمنا ابو خليل / من خلال تجربتى للموقع على حسب السؤال تكون الاجابة لذلك قبل السؤال يجب تحديد المطلوب بدقة ويمكن مناقشته في جزء في الكود واطلب اي تعديل فيه وللعلم ليس لدي الخلفية الجيدة لفهم الاكواد ووضعت سؤالك التالي حرفيا ولكن التغيير في الجدول احيانا غير مرغوب .. فمثلا اسمي إبراهيم فأنا لا اريد ان يظهر اسمي في التقرير ابراهيم بدون همز جميل لو كانت هذه الدالة في عمود خاص في الاستعلام من اجل التصفية والبحث فاجابنى فهمت، يمكنك استخدام الدالة في استعلام Access بحيث يتم إنشاء عمود جديد يحتوي على النصوص المعدلة دون التأثير على البيانات الأصلية في الجدول. إليك كيفية القيام بذلك: افتح قاعدة البيانات في Access. أنشئ استعلامًا جديدًا. في تصميم الاستعلام، أضف الجدول الذي يحتوي على الأسماء. في عمود جديد في شبكة التصميم، أدخل التعبير التالي AdjustedName: AdjustHamzat([اسم_العمود]) حيث “اسم_العمود” هو اسم العمود الذي يحتوي على الأسماء الأصلية. إليك الكود الكامل للدالة التي يمكنك استخدامها في وحدة نمطية (Module) في Access Function AdjustHamzat(inputText As String) As String Dim result As String result = Replace(inputText, "أ", "ا") result = Replace(result, "آ", "ا") result = Replace(result, "إ", "ا") result = Replace(result, "ة", "ه") result = Replace(result, "ى", "ي") AdjustHamzat = result End Function بهذه الطريقة، يمكنك استخدام العمود الجديد “AdjustedName” في التصفية والبحث دون التأثير على الأسماء الأصلية في الجدول. إذا كنت بحاجة إلى أي مساعدة إضافية، لا تتردد في السؤال! انتهى كلام الذكاء واذا كانت الاجابة غير مرضيه اخبره بذلك وسيعطيك حلولا اخرى

اما طلبك الاخير فاجابنى يمكنك استخدام الكود التالي في Microsoft Access لفرز الأسماء أبجديًا بحيث يبدأ بالذكور أولاً، ثم الإناث. سنفترض أن لديك حقلًا يسمى “الجنس” يحتوي على “ذكر” أو “أنثى”، وحقلًا آخر يسمى “الاسم” يحتوي على الأسماء Sub SortNamesByGender() Dim db As DAO.Database Dim rs As DAO.Recordset Dim sql As String Set db = CurrentDb ' SQL query to sort names by gender first, then alphabetically sql = "SELECT * FROM [اسم_الجدول] ORDER BY [الجنس] DESC, [الاسم] ASC" Set rs = db.OpenRecordset(sql) ' Loop through the sorted recordset and print names (or perform any other action) Do While Not rs.EOF Debug.Print rs!الاسم rs.MoveNext Loop rs.Close Set rs = Nothing Set db = Nothing End Sub تأكد من استبدال [اسم_الجدول] بأسم الجدول الفعلي في قاعدة البيانات الخاصة بك. هذا الكود يقوم بفرز الأسماء بحيث يبدأ بالذكور أولاً (لأننا نستخدم DESC في ترتيب الجنس)، ثم يرتب الأسماء أبجديًا اسم الموقع وهو مجاني ويحتاج تسجيل الاشتراك فيه https://copilot.microsoft.com/ وعذرا ان كنت تجاوزت القوانين المعمول بها في المنتدى