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

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

اما طلبك الثاني فاجابنى يمكنك استخدام الكود التالي في Microsoft Access لضبط الأسماء التي تبدأ بكلمة “عبد” وتحويلها إلى الشكل الصحيح بدون مسافة، مثل “عبدالرحمن”: Sub AdjustNames() Dim db As DAO.Database Dim rs As DAO.Recordset Dim name As String Set db = CurrentDb Set rs = db.OpenRecordset("SELECT [اسم_الحقل] FROM [اسم_الجدول]") Do While Not rs.EOF name = rs!اسم_الحقل ' Check if the name starts with "عبد " (with a space) If Left(name, 4) = "عبد " Then ' Remove the space after "عبد" rs.Edit rs!اسم_الحقل = Replace(name, "عبد ", "عبد") rs.Update End If rs.MoveNext Loop rs.Close Set rs = Nothing Set db = Nothing End Sub تأكد من استبدال [اسم_الحقل] و [اسم_الجدول] بأسماء الحقل والجدول الفعلية في قاعدة البيانات الخاصة بك. هذا الكود يقوم بالبحث في الحقل المحدد في الجدول، وإذا وجد اسمًا يبدأ بـ "عبد " (مع مسافة)، يقوم بإزالة المسافة

السلام عليكم / طرحت سؤالك على موقع برنامج الذكاء الاصطناعي واتمنى من الخبراء ابداء رأيهم في الكود علما بأن صيغة السؤال كانت كالتالي :-محتاج كوداكسس لضبط الهمزات بمعني ( أ - آ - إ - ة - ى ) تحول إلي ( ا-ا-ا-ه - ي ) فاجابنى : يمكنك استخدام الكود التالي في VBA لضبط الهمزات في النصوص داخل قاعدة بيانات Access. هذا الكود يقوم بتحويل الأحرف (أ - آ - إ - ة - ى) إلى (ا - ا - ا - ه - ي): Function AdjustHamzat(inputText As String) As String Dim adjustedText As String adjustedText = inputText adjustedText = Replace(adjustedText, "أ", "ا") adjustedText = Replace(adjustedText, "آ", "ا") adjustedText = Replace(adjustedText, "إ", "ا") adjustedText = Replace(adjustedText, "ة", "ه") adjustedText = Replace(adjustedText, "ى", "ي") AdjustHamzat = adjustedText End Function Sub UpdateHamzatInTable() Dim db As DAO.Database Dim rs As DAO.Recordset Dim fieldName As String Dim tableName As String ' اسم الجدول واسم الحقل المراد تحديثه tableName = "YourTableName" fieldName = "YourFieldName" Set db = CurrentDb Set rs = db.OpenRecordset("SELECT * FROM " & tableName) If Not rs.EOF Then rs.MoveFirst Do While Not rs.EOF rs.Edit rs(fieldName).Value = AdjustHamzat(rs(fieldName).Value) rs.Update rs.MoveNext Loop End If rs.Close Set rs = Nothing Set db = Nothing End Sub هذا الكود يحتوي على دالة AdjustHamzat التي تقوم بتحويل الأحرف المطلوبة، ودالة UpdateHamzatInTable التي تقوم بتحديث الحقل المحدد في الجدول. تأكد من تعديل YourTableName وYourFieldName بأسماء الجدول والحقل المناسبين في قاعدة البيانات الخاصة بك. انتهت اجابة الموقع نتمنى ان تجربه وتخبرنا بالنتيجة كذلك يجب تفعيل مكتبةDAO

اظافة ما تفضل به معلمنا محمد صالح ومعلمنا محمد هشام يمكن استخدام المعادلة التالية فى حالة وضعها في عمود اخر =CONCATENATE("'"; A2) Copy of OverTime Transaction Upload Template.xlsx

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

وعليكم السلام ورحمة الله وبركاته عذرا اخي الفاضل كثرة الطلبات تجعل الكثير لا يكترث بالموضوع لأنه يحتاج الى وقت وجهد فكري فأنصحك ان يكون في موضوعك طلب واحد محدد اذا تم الاجابة علية افتح موضوع جديد واكتب فيه طلبك الثاني وهكذا الطلب الاول تم تنفيذه لك وافر الاحترام acheivements final.xlsb

اخي العزيز اذا كنت تقصد ان البيانات الناتجة عن الفلترة اذا كانت اكثر من صفحة واحدة وتريد طباعتها في صفحة واحدة ربما هذا الملف قيه الحل 'طباعة حسب البيانات1.xlsm

وعليكم السلام ورحمة الله وبركاته اختصار للوقت ولسرعة الاستجابة لطلبك ارفق الملف للتعرف على المشكلة

وعليكم السلام ورحمة الله وبركاته 'طباعة حسب البيانات.xlsm

وعليكم السلام ورحمة الله وبركاته ضف هذا السطر قبل الخطأ مباشرة On Error Resume Next st = Mid(Trim(.Cells(i, 2)), 1, 1)

وعليكم السلام ورحمة الله وبركاته جسب فهمى لطلبك / قم باختيار الصف م خلية Z2 في صفحة البيانات ثم قم بالضغظ على زر ترحيل . سيتم الترحيل الى صفحتي المستجدين وسجل 31, امر الطباعة ديناميكي بمعني حسب البيانات يحتويها ويطبعها فليس هناك داع لزر الاختيار الامر الثالت غير واضح تماما بالنسبة لي والذي فهمته انك تريد الترحيل حسب التقدم فمثلا تريد ترحيل الدور الاول هل الترحيل لفصل معين ام لكل الفصول. اتمنى ان تجد ما يفيدك وان كان غير ذلك فعذرا . ترحيل.zip

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

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

تم ربط زر التبديل ب Get_Data_By_Subject قوائم لجان الدور الثاني - Copy.xlsb

السلام عليكم lionheart اعتقد ان صاحب الملف كما قال انه لم يعطى له نتائج بسبب عدم اضافة الكود Get_Data_By_Subject الى زر او الى صفحةLagna فيكون كالاتي Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$L$3" Then Application.ScreenUpdating = False Range("B9:I28").ClearContents Application.ScreenUpdating = True End If Get_Data_By_Subject End Sub وهذا ملف كامل به كود استاذنا lionheart وقمت بالتجربة فتم استدعاء الطلبة حسب المادة حقيقة سرعة ابداع اتقان زادك الله رفعة وعلما استاذنا الفاضل الملف قوائم لجان الدور الثاني - Copy.xlsb

من افضل الدروس لربط الاكسل VB6 وفيه علم عزير وبه امثلة متضمنة اكواد الربط للاستاذ ياسر العربي في ميزان اعماله وحسناته https://www.officena.net/ib/topic/65629-سلسلة-دروس-الفيجوال-بيسك-6-والاكسيل-من-علي-مصطبة-ياسر-العربي/

ارفق الملف لنرى ما السبب رعاك الله