أبومروان

السلام عليكم ورحمه الله ارجو يكون المطلوب ترحيل.xlsx

وعليكم السلام ورحمه الله

وعليكم السلام ورحمه الله وبركاته من الواضح أنك تواجه مشكلة في فتح ملفات إكسل القديمة على جهازك، ولكن البرنامج يعمل بشكل طبيعي عند فتح مستندات جديدة أو عند تشغيله من قائمة "ابدأ". هذه المشكلة قد تكون ناتجة عن عدة أسباب. إليك بعض الحلول التي يمكن أن تساعدك في حل المشكلة: 1. إعادة تشغيل الكمبيوتر أول خطوة يجب أن تحاولها هي إعادة تشغيل جهاز الكمبيوتر. قد يكون هناك بعض العمليات التي تمنع إكسل من العمل بشكل صحيح. 2. تشغيل إكسل في الوضع الآمن قد تكون هناك مشكلة في الإضافات أو في إعدادات إكسل. جرب تشغيل إكسل في "الوضع الآمن" لحل هذه المشكلة. اضغط على مفتاح Ctrl باستمرار ثم افتح إكسل. إذا عمل إكسل بشكل طبيعي في الوضع الآمن، فالمشكلة قد تكون في إحدى الإضافات أو في ملف التكوين الخاص بالبرنامج. 3. إلغاء تثبيت التحديثات الأخيرة إذا كنت قد قمت بتثبيت تحديثات لأوفيس مؤخرًا، قد تكون هذه التحديثات قد تسببت في حدوث المشكلة. جرب إلغاء تثبيت آخر التحديثات: اذهب إلى إعدادات النظام في جهازك. اختر التطبيقات ثم ابحث عن Microsoft Office 2019. اختر إلغاء التثبيت أو إصلاح. 4. إصلاح أوفيس إذا كنت قد قمت بتثبيت أوفيس 2019 بنجاح، يمكنك محاولة إصلاح البرنامج عبر إعدادات أوفيس: افتح لوحة التحكم. اختر البرامج ثم البرامج والميزات. ابحث عن Microsoft Office 2019، واضغط عليه. اختر إصلاح ثم اختر الإصلاح السريع أو الإصلاح عبر الإنترنت. 5. تحقق من الأمان والحقوق تأكد من أن ملفات إكسل القديمة التي لا تفتح ليست محمية أو غير قابلة للوصول بسبب إعدادات الأمان على جهازك: تحقق من أن الملفات ليست قيد الحماية أو مملوكة لمستخدم آخر. تحقق من أن لديك صلاحيات كافية للوصول إليها. 6. تحديث إصدار إكسل أو أوفيس من الممكن أن المشكلة تتعلق بإصدار قديم من البرنامج. تأكد من أنك قد قمت بتحديث أوفيس إلى آخر إصدار: افتح أي برنامج من أوفيس (مثل إكسل). اذهب إلى ملف ثم حساب. اختر خيارات التحديث ثم تحديث الآن. 7. إزالة ذاكرة التخزين المؤقتة والملفات التالفة إذا كانت هناك ملفات تالفة قد تسبب المشكلة، حاول مسح الملفات المؤقتة الخاصة بأوفيس: اذهب إلى مستعرض الملفات ثم اكتب %appdata%\Microsoft\Excel في شريط العنوان. احذف أي ملفات تالفة أو غير ضرورية في هذا المجلد. 8. التحقق من التوافق إذا كانت الملفات التي لا تفتح قد تم إنشاؤها باستخدام إصدار قديم من إكسل، قد تكون هناك مشكلة في التوافق. جرب فتح الملف باستخدام إصدار آخر من إكسل أو استخدام الأدوات عبر الإنترنت مثل Excel Online لتحديد ما إذا كانت المشكلة في الملف نفسه. 9. إعادة تثبيت أوفيس إذا لم تنجح أي من الحلول السابقة، قد تحتاج إلى إعادة تثبيت أوفيس بشكل كامل: قم بإلغاء تثبيت Microsoft Office 2019 عبر لوحة التحكم. ثم أعد تثبيت الأوفيس من موقع مايكروسوفت الرسمي

السلام عليكم، هل يمكنك مراجعة المواضيع أدناه؟ قد تساعدك في المطلوب.

الحمد لله الذي بِنِعْمَتِهِ تتم الصالحات وبشكره تدوم النعم، والحمدلله الذي بتوفيقه وتيسيره تصلح الأمور وتتم كُبرى النعم

الحمد لله الذي بِنِعْمَتِهِ تتم الصالحات وبشكره تدوم النعم، والحمدلله الذي بتوفيقه وتيسيره تصلح الأمور وتتم كُبرى النعم،

وعليكم السلام ورحمه الله وبركاته اتفضل لعله المطلوب Sub CustomSortByGender() Dim ws As Worksheet Dim lastRow As Long Dim maleList As Collection, femaleList As Collection Dim i As Long, rowIndex As Long Dim gender As String Dim maleRow As Long, femaleRow As Long ' تحديد الورقة النشطة (تأكد من تعديل الاسم إذا لزم الأمر) Set ws = ThisWorkbook.Sheets("Sheet1") ' تأكد من أن اسم الورقة صحيح ' تحديد آخر صف في العمود A (الذي يحتوي على بيانات) lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' إنشاء مجموعات لتخزين الذكور والإناث Set maleList = New Collection Set femaleList = New Collection ' تصنيف البيانات في العمود F إلى مجموعات الذكور والإناث For i = 2 To lastRow ' بدءًا من F2 gender = ws.Cells(i, "F").Value If gender = "ذكر" Then maleList.Add i ' إضافة رقم الصف إلى قائمة الذكور ElseIf gender = "أنثى" Then femaleList.Add i ' إضافة رقم الصف إلى قائمة الإناث End If Next i ' إعادة ترتيب البيانات في العمود F حسب التكرار المطلوب rowIndex = 2 ' نبدأ من F2 Do While maleList.Count > 0 Or femaleList.Count > 0 ' إضافة 2 ذكر If maleList.Count >= 2 Then maleRow = maleList(1) ws.Rows(maleRow).Copy ws.Rows(rowIndex).PasteSpecial Paste:=xlPasteAll maleList.Remove 1 maleList.Remove 1 rowIndex = rowIndex + 1 maleRow = maleList(1) ws.Rows(maleRow).Copy ws.Rows(rowIndex).PasteSpecial Paste:=xlPasteAll maleList.Remove 1 rowIndex = rowIndex + 1 ElseIf maleList.Count = 1 Then maleRow = maleList(1) ws.Rows(maleRow).Copy ws.Rows(rowIndex).PasteSpecial Paste:=xlPasteAll maleList.Remove 1 rowIndex = rowIndex + 1 End If ' إضافة 2 أنثى If femaleList.Count >= 2 Then femaleRow = femaleList(1) ws.Rows(femaleRow).Copy ws.Rows(rowIndex).PasteSpecial Paste:=xlPasteAll femaleList.Remove 1 femaleList.Remove 1 rowIndex = rowIndex + 1 femaleRow = femaleList(1) ws.Rows(femaleRow).Copy ws.Rows(rowIndex).PasteSpecial Paste:=xlPasteAll femaleList.Remove 1 rowIndex = rowIndex + 1 ElseIf femaleList.Count = 1 Then femaleRow = femaleList(1) ws.Rows(femaleRow).Copy ws.Rows(rowIndex).PasteSpecial Paste:=xlPasteAll femaleList.Remove 1 rowIndex = rowIndex + 1 End If Loop End Sub فرز حسب الجنس بشروط.xlsm فرز حسب الجنس بشروط.xlsm

وعليكم السلام ورحمه الله وبركاته راجع الموضوع ادناه لعله تجد ما يفيدك ويحل المشكله 1. اذهب الى Start ثم Settings 2 . اختر Control Panel 3. Regional And Language Options 4. من تبويب Advanced في خانة الاختيار اختر اللغة العربية 5. ثم OK ==================================== في محرر الاكواد من قائمة Tools ثم Option من تاب Editor Format ثم Font اختر نوع الخط هذا Courier New (Arabic)

الحمد لله، وأنا سعيد لأن الأمور تمّت بشكل جيد! إذا كنت بحاجة إلى أي مساعدة أخرى فلا تتردد في السؤال. أسأل الله أن يوفقك في كل ما تقوم به. 😊

اشكرك علي التوضيح اذان كود وملف المرفق استاذنا @عبدالله بشير عبدالله يعمل بدون اذني مشكله ويفي بالمطلوب ان شاء الله

اتفضل الشيت بالكود المستخدم لعله يكون الطلوب وعدل عليه حسب ما تريد Sub PrintSheetInChunks() Dim ws As Worksheet Dim LastRow As Long, LastCol As Long Dim RowStart As Long, RowEnd As Long Dim ColStart As Long, ColEnd As Long Dim PageNum As Long ' تحديد ورقة العمل الحالية Set ws = ThisWorkbook.Sheets("Sheet1") ' قم بتغيير اسم الورقة حسب الحاجة ' الحصول على آخر صف وآخر عمود في البيانات LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column ' تحديد عدد الصفوف والأعمدة لكل صفحة (25 صفًا و25 عمودًا) RowStart = 1 ColStart = 1 PageNum = 1 ' تحديد الصفوف والأعمدة للطباعة Do While RowStart <= LastRow RowEnd = RowStart + 24 ' 25 صفًا لكل صفحة (من RowStart إلى RowEnd) If RowEnd > LastRow Then RowEnd = LastRow ColEnd = ColStart + 24 ' 25 عمودًا لكل صفحة (من ColStart إلى ColEnd) If ColEnd > LastCol Then ColEnd = LastCol ' تحديد منطقة الطباعة ws.PageSetup.PrintArea = ws.Range(ws.Cells(RowStart, ColStart), ws.Cells(RowEnd, ColEnd)).Address ' إعدادات الطباعة With ws.PageSetup .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = False .PrintTitleRows = "" ' إذا أردت إضافة عناوين ثابتة في الأعلى يمكنك تعديل هذه .PrintTitleColumns = "" ' وإذا أردت إضافة أعمدة ثابتة يمكنك تعديل هذه End With ' طباعة الصفحة ws.PrintOut ' تحديث الصفوف والأعمدة للطباعة في الصفحة التالية RowStart = RowEnd + 1 If RowStart > LastRow Then Exit Do ' الخروج إذا تم الانتهاء من جميع الصفوف If ColEnd < LastCol Then ColStart = ColEnd + 1 Else ColStart = 1 End If PageNum = PageNum + 1 Loop End Sub مرتبات.xlsm

وعليكم السلام ورحمه الله وبركاته اكواد لتحسين الاداء Sub OptimizePerformance() ' إيقاف التحديثات على الشاشة Application.ScreenUpdating = False ' إيقاف الحسابات التلقائية Application.Calculation = xlCalculationManual ' إيقاف الأحداث Application.EnableEvents = False ' إيقاف التنبيهات Application.DisplayAlerts = False ' إيقاف الحفظ التلقائي Application.AutoRecover.Enabled = False ' إعادة تمكين كافة الإعدادات بعد الانتهاء Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.DisplayAlerts = True Application.AutoRecover.Enabled = True End Sub

والسلام عليكم ورحمة الله وبركاته جرب الكود التالي لعله المطلوب Sub Print25RowsPerPage() Dim wsSource As Worksheet Dim rowCount As Long Dim rowsPerPage As Long Dim i As Long Dim printRange As Range Dim pageNum As Long ' تحديد ورقة العمل المصدر Set wsSource = ThisWorkbook.Sheets("ورقة1") ' تأكد من تغيير اسم الورقة إلى الورقة المناسبة rowCount = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row ' حساب عدد الصفوف rowsPerPage = 25 ' عدد الصفوف في كل ورقة pageNum = 1 ' لتتبع رقم الصفحة أثناء الطباعة ' التكرار عبر الصفوف وتقسيمها على أوراق الطباعة For i = 1 To rowCount Step rowsPerPage ' تحديد نطاق الطباعة (25 صفًا لكل ورقة) Set printRange = wsSource.Rows(i & ":" & WorksheetFunction.Min(i + rowsPerPage - 1, rowCount)) ' تعيين نطاق الطباعة wsSource.PageSetup.PrintArea = printRange.Address ' تعيين إعدادات الطباعة (اختياري: إذا كنت تريد تغيير إعدادات الطباعة) With wsSource.PageSetup .Orientation = xlPortrait ' وضع الصفحة عمودي (يمكنك تغييره إلى xlLandscape إذا أردت الوضع الأفقي) .FitToPagesWide = 1 ' تأكد من طباعة الصفحة على عرض واحد .FitToPagesTall = False ' لا تحدد عدد الصفوف على الصفحة .LeftHeader = "صفحة " & pageNum ' عنوان الصفحة End With ' طباعة النطاق المحدد wsSource.PrintOut ' تحديث رقم الصفحة pageNum = pageNum + 1 Next i

وعليكم السلام ورحمه الله وبركاته بعد اذن استاذي @عبدالله بشير عبدالله حل اخر بالمعادلات =IF(ISNA(VLOOKUP(A1, 'إزالة من القائمة'!A:A, 1, FALSE)), "إبقاء", "إزالة")

وعليكم السلام ورحمه الله وبركاته ممكن تستخدم الكود التالي لعله المطلوب Sub ColorCellsAboveYellow() Dim ws As Worksheet Dim cell As Range Dim targetColor As Long Dim i As Integer Set ws = ThisWorkbook.Sheets("Sheet1") targetColor = RGB(255, 255, 0) For Each cell In ws.UsedRange If cell.Interior.Color = targetColor Then For i = 1 To 2 If cell.Row - i > 0 Then ws.Cells(cell.Row - i, cell.Column).Interior.Color = targetColor End If Next i End If Next cell End Sub Book1.xlsm

شغاله عندي بدون ادني مشكله

وعليكم السلام ورحمه الله وبركاته اتفضل استاذ @mahmoud nasr alhasany ارجو ان يكون هذا هو المطلوب وليك الاكواد المستخدمه لتفعيل f4 يجب الوفقوف علي textbox3 وسيتم تشغيل الكود المجود فيه كما ترا ادناه Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 115 Then CommandButton1_Click ' هنا ضع الامر الذي تريد تنفيذه بعد الضغط على زر انتر End If End Sub لتفعيل f4 يجب الوفقوف علي ListBox1 وسيتم تشغيل الكود المجود فيه كما ترا ادناه Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 113 Then CommandButton2_Click ' هنا ضع الامر الذي تريد تنفيذه بعد الضغط على زر انتر End If End Sub شاشة عميل بحث.xlsm شاشة عميل بحث.xlsm

هذه المشكلة تحدث عادةً بسبب اختلاف الترميز بين الملف الأصلي وبرنامج Excel الذي تستخدمه. قد تكون النصوص مكتوبة بترميز معين (مثل ANSI) بينما يستخدم Excel ترميزًا آخر (مثل UTF-8). لحل هذه المشكلة، يمكنك محاولة حفظ الملف بتنسيق جديد يدعم الترميز الصحيح. إليك كيفية القيام بذلك: 1. **فتح الملف في Excel:** - افتح الملف بامتداد `.xls` في Excel. 2. **حفظ الملف بتنسيق جديد:** - اذهب إلى قائمة **File** (ملف). - اختر **Save As** (حفظ باسم). - في نافذة الحفظ، اختر تنسيق الملف **.xlsx** من القائمة المنسدلة. - احفظ الملف بهذا التنسيق الجديد. 3. **إعادة فتح الملف:** - اغلق الملف وافتح النسخة المحفوظة بتنسيق `.xlsx`. إذا استمرت المشكلة بعد ذلك، يمكنك محاولة استخدام **Notepad** لتحويل الترميز: 1. **فتح الملف في Notepad:** - افتح الملف بامتداد `.xls` في Notepad (قد تحتاج إلى تغيير امتداد الملف مؤقتًا إلى `.txt`). 2. **حفظ الملف بترميز جديد:** - في Notepad، اذهب إلى قائمة **File** (ملف) واختر **Save As** (حفظ باسم). - اختر **UTF-8** من قائمة الترميز في أسفل نافذة الحفظ. - احفظ الملف بهذا التنسيق الجديد. 3. **إعادة تسمية الملف وفتحه في Excel - قم بإعادة تسمية الملف إلى امتداده الأصلي `.xls` وافتحه في Excel.

السلام عليكم ورحمه الله وبركاته ما هو التعديل المطلوب بالتحديد ملف المدرسة كامل الفصول 2024-2023.7z

وعليكم السلام تأكد من أن إعدادات اللغة في Excel تدعم العربية. استخدم ترميز Unicode عند حفظ الملف لتجنب فقدان النصوص. قم بتحديث Excel إلى أحدث إصدار. إصلاح الملف باستخدام أداة الإصلاح إذا كان الملف تالفًا. تأكد من إعدادات اللغة في Windows إذا كانت المشكلة مستمرة.

وعليكم السلام ورحمه الله وبركاته ارجو ان يكون المطلوب كود الترقيم Sub NumberRows() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Set ws = ThisWorkbook.Sheets("ورقة1") lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row For i = 2 To lastRow ws.Cells(i, "A").Value = i - 1 Next i End Sub كود التصفيه بعد التعديل Sub DeleteRows() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Dim deleteCount As Long Dim response As VbMsgBoxResult Set ws = ThisWorkbook.Sheets("ورقة1") ' تحديث العمود الذي يتم حساب آخر صف فيه من A إلى B lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row deleteCount = 0 response = MsgBox("هل أنت متأكد أنك تريد حذف من استلمو الاول والثاني", vbYesNo + vbQuestion, "تأكيد الحذف") If response = vbYes Then ' بدأ من الصف الأخير حتى الصف 3 كما في الكود الأصلي For i = lastRow To 3 Step -1 ' العمل على العمود B و C للتحقق من وجود القيم قبل حذف الصف If ws.Cells(i, 2).Value <> "" And ws.Cells(i, 3).Value <> "" Then ws.Rows(i).Delete deleteCount = deleteCount + 1 End If Next i MsgBox deleteCount & " صفوف تم حذفها.", vbInformation, "عملية الحذف" Else MsgBox "تم إلغاء عملية الحذف.", vbInformation, "إلغاء" End If ' تنسيق النصوص في النطاق B1:D50 بدلاً من A1:D50 With ws.Range("B1:D50").Font ' تغيير النطاق ليشمل العمود B بدلاً من A .Name = "Arial" .Size = 16 .Bold = True .Color = RGB(0, 0, 251) ' الأزرق End With ' إعداد الهوامش للطباعة With ActiveSheet.PageSetup .TopMargin = Application.InchesToPoints(0.5) .BottomMargin = Application.InchesToPoints(0.5) .LeftMargin = Application.InchesToPoints(0.5) .RightMargin = Application.InchesToPoints(0.5) End With ' كتابة التاريخ في العمود B (تم تحديثه من العمود A) ws.Range("B1").Value = Date - 1 ws.Range("B1").NumberFormat = "dd/mm/yyyy" ' إزاحة التاريخ اليومي لكتابة اليوم في العمود A ws.Range("A1").Value = Format(Date - 1, "dddd") NumberRows End Sub كود حذف وتنسيق وادراج (1).xlsm

السلام عليكم ورحمه الله وبركاته علي ما قدر مافهمت المطلوب =VLOOKUP(B2,البيانات!$A$2:$G$15,MATCH(C2,البيانات!$A$1:$G$1,0),0)

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

جزاك الله كل خير على قدر أهل العزم تأتي العزائم وتأتي على قدر الكرام المكارم وتعظم في عين الصغير صغارها وتصغر في عين العظيم العظائم