abouelhassan

للاسف اخى الملف لم يفتح حاول تشرح لى المطلوب فى نقاط نبتدى بالترحيل أو بالاستدعاء ونكمل البرنامج خطوة خطوة تمام

وضح المطلوب اخى الكريم

لحل مشكلة ظهور الأرقام باللغة العربية في Excel عند كتابة المعادلات أو التحرير، يمكنك اتباع الخطوات التالية: 1. افتح Excel وانتقل إلى قائمة "ملف" (File) في شريط الأدوات العلوي. 2. اختر "خيارات" (Options) من القائمة. 3. انتقل إلى قسم "عام" (General) في النافذة الجديدة. 4. تأكد من أن خيار "اللغة التلقائية" (Automatic language) مُعطل. 5. قم بتحديد اللغة المفضلة لك في خانة "لغة التحرير" (Editing Language). 6. اضغط على زر "موافق" (OK) لحفظ التغييرات. بالنسبة لمشكلة اختفاء زر "Sheet" في قائمة تخطيط الصفحة، يمكنك تجربة الخطوات التالية: 1. افتح Excel وانتقل إلى قائمة "ملف" (File). 2. اختر "خيارات" (Options) من القائمة. 3. انتقل إلى قسم "شريط الأدوات الرئيسي" (Customize Ribbon). 4. تحقق من وجود علامة اختيار أمام خيار "ورقة" (Sheet) في القائمة على اليمين. 5. إذا لم يكن هناك علامة اختيار، قم بتحديدها. 6. اضغط على زر "موافق" (OK) لحفظ التتغير

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

جرب Private Sub UserForm_Initialize() Dim ws As Worksheet Dim lastRow As Long Dim i As Long ' تحديد ورقة العمل التي تحتوي على البيانات Set ws = ThisWorkbook.Sheets("Sheet1") ' قم بتغيير اسم الورقة حسب اسم ورقتك ' احتساب عدد الصفوف الممتلئة في العمود A lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' تحميل البيانات إلى ListBox وتنسيقها For i = 2 To lastRow ' افترضنا هنا أن البيانات تبدأ من الصف 2، يمكنك تغيير الرقم إذا لزم الأمر ListBox1.AddItem Format(ws.Cells(i, 1).Value, "0.000") ' المبيعات ListBox1.List(ListBox1.ListCount - 1, 1) = Format(ws.Cells(i, 2).Value, "0.000") ' العمولة ListBox1.List(ListBox1.ListCount - 1, 2) = Format(ws.Cells(i, 3).Value, "0.000") ' صافي المبيعات Next i End Sub Private Sub ListBox1_Click() Dim selectedRow As Long ' الحصول على الصف المحدد في ListBox selectedRow = ListBox1.ListIndex ' التحرك إلى الخلية المقابلة في ورقة العمل If selectedRow >= 0 Then ThisWorkbook.Sheets("Sheet1").Cells(selectedRow + 2, 1).Select ' نفترض أن البيانات تبدأ من الصف 2 End If End Sub

اختار افضل اجابه لو تكرمت

جرب Sub نقل_البيانات() Dim ws As Worksheet Dim wsResult As Worksheet Dim lastRow As Long Dim i As Long Dim nextRow As Long ' افتح ورقة العمل الحالية Set ws = ThisWorkbook.Sheets("Sheet1") ' استبدل "Sheet1" باسم ورقة العمل الخاصة بك ' قم بإنشاء ورقة النتيجة إذا لم تكن موجودة بالفعل On Error Resume Next Set wsResult = ThisWorkbook.Sheets("النتيجة هنا") On Error GoTo 0 If wsResult Is Nothing Then Set wsResult = Sheets.Add(After:=Sheets(Sheets.Count)) wsResult.Name = "النتيجة هنا" End If ' حساب آخر صف غير فارغ في عمود F lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row ' نقل البيانات إلى ورقة النتيجة باستثناء الأسطر الفارغة في عمود F nextRow = 1 ' الصف التالي المتاح في ورقة النتيجة For i = 1 To lastRow If ws.Cells(i, "F").Value <> "" Then ws.Rows(i).Copy wsResult.Rows(nextRow) nextRow = nextRow + 1 End If Next i MsgBox "تم نقل البيانات بنجاح!" End Sub

جرب Sub InsertPageBreaks() Dim ws As Worksheet Dim rowsPerPage As Integer Dim lastRow As Long Dim i As Long ' تعيين عدد الصفوف في كل صفحة rowsPerPage = 24 ' تحديد الورقة التي ترغب في تطبيق الفواصل عليها Set ws = ThisWorkbook.Sheets("Sheet1") ' تغيير "Sheet1" إلى اسم الورقة الخاصة بك ' حذف الفواصل الحالية إن وجدت ws.ResetAllPageBreaks ' الحصول على آخر صف غير فارغ في الورقة lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' إدراج فواصل الصفحات بعد كل rowsPerPage صف For i = rowsPerPage To lastRow Step rowsPerPage ws.Rows(i).PageBreak = xlPageBreakManual Next i End Sub قم بتغيير "Sheet1" في السطر Set ws = ThisWorkbook.Sheets("Sheet1") إلى اسم الورقة التي ترغب في تطبيق الفواصل عليها. قم بتعديل قيمة rowsPerPage إلى العدد المطلوب من الصفوف في كل صفحة.

جرب Sub إنشاء_صف_جديد() ' تحديد الصف الحالي Dim صف_حالي As Integer صف_حالي = ActiveCell.Row ' نسخ الصف الحالي Rows(صف_حالي & ":" & صف_حالي).Copy ' لصق في الصف التالي Rows(صف_حالي + 1 & ":" & صف_حالي + 1).Insert Shift:=xlDown ' ضبط الترقيم التلقائي للصفوف Rows(صف_حالي + 1).Cells(1, 1).Formula = Rows(صف_حالي).Cells(1, 1).Formula + 1 ' إلغاء تحديد الصفوف Application.CutCopyMode = False End Sub للتنفيذ بواسطة زر انتر استخدم الاتى Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) ' تحقق من أن الزر هو زر Enter If Target.Address = ActiveCell.Address Then ' الكود الذي يقوم بإنشاء صف جديد Rows(Target.Row & ":" & Target.Row).Copy Rows(Target.Row + 1 & ":" & Target.Row + 1).Insert Shift:=xlDown Rows(Target.Row + 1).Cells(1, 1).Formula = Rows(Target.Row).Cells(1, 1).Formula + 1 Application.CutCopyMode = False ' إلغاء تنفيذ افتتاح زر Enter Cancel = True End If End Sub

جرب Sub نقل_البيانات() Dim ws As Worksheet Dim wsResult As Worksheet Dim lastRow As Long Dim i As Long ' افتح ورقة العمل الحالية Set ws = ThisWorkbook.Sheets("Sheet1") ' استبدل "Sheet1" باسم ورقة العمل الخاصة بك ' قم بإنشاء ورقة النتيجة إذا لم تكن موجودة بالفعل On Error Resume Next Set wsResult = ThisWorkbook.Sheets("النتيجة هنا") On Error GoTo 0 If wsResult Is Nothing Then Set wsResult = Sheets.Add(After:=Sheets(Sheets.Count)) wsResult.Name = "النتيجة هنا" End If ' حساب آخر صف غير فارغ في عمود F lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row ' نقل البيانات إلى ورقة النتيجة باستثناء الأسطر الفارغة في عمود F For i = 1 To lastRow If ws.Cells(i, "F").Value <> "" Then ws.Rows(i).Copy wsResult.Rows(wsResult.Cells(wsResult.Rows.Count, "A").End(xlUp).Row + 1) End If Next i MsgBox "تم نقل البيانات بنجاح!" End Sub

يمكننا ضبط الكود لتحقيق ذلك. يتم وضع كل اسم في خلية واحدة، والأسماء المختلفة تُفصل بواسطة سطر جديد في نفس الخلية. اليك الكود المعدل Private Sub Workbook_Open() ' جعل الصفحة من اليمين والتنسيق في المنتصف With ActiveWindow .WindowState = xlMaximized .DisplayRightToLeft = True End With ' تنسيق الأرقام بخط عريض بحجم 14 Cells.NumberFormat = "0" Cells.Font.Size = 14 ' تنسيق العمود A برقم مخصص 000000 Columns("A").NumberFormat = "000000" ' تنسيق العمود B بتكست Columns("B").NumberFormat = "@" ' تقسيم الأسماء في العمود C Dim lastRow As Long lastRow = Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To lastRow Dim fullNameA As String Dim fullNameB As String Dim combinedNames As String ' قراءة الأسماء من العمود A و B fullNameA = Cells(i, "A").Value fullNameB = Cells(i, "B").Value ' المقارنة والتحقق من الأسماء المتطابقة If InStr(fullNameB, fullNameA) > 0 Or InStr(fullNameA, fullNameB) > 0 Then combinedNames = fullNameA Else combinedNames = fullNameA & vbCrLf & fullNameB End If ' وضع الأسماء في العمود C Cells(i, "C").Value = combinedNames Next i End Sub

في الكود أدناه، يتم مقارنة الأسماء في العمود A والعمود B، وإذا كانت الأسماء متطابقة، يُكتب الاسم في العمود C، وإذا كانت مختلفة، يتم فصلها تمامًا في العمود 😄 Private Sub Workbook_Open() ' جعل الصفحة من اليمين والتنسيق في المنتصف With ActiveWindow .WindowState = xlMaximized .DisplayRightToLeft = True End With ' تنسيق الأرقام بخط عريض بحجم 14 Cells.NumberFormat = "0" Cells.Font.Size = 14 ' تنسيق العمود A برقم مخصص 000000 Columns("A").NumberFormat = "000000" ' تنسيق العمود B بتكست Columns("B").NumberFormat = "@" ' تقسيم الأسماء في العمود C Dim lastRow As Long lastRow = Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To lastRow Dim fullNameA As String Dim fullNameB As String ' قراءة الأسماء من العمود A و B fullNameA = Cells(i, "A").Value fullNameB = Cells(i, "B").Value ' المقارنة والفصل في العمود C If InStr(fullNameB, fullNameA) > 0 Or InStr(fullNameA, fullNameB) > 0 Then Cells(i, "C").Value = fullNameA Else Cells(i, "C").Value = fullNameA & " / " & fullNameB End If Next i End Sub

لإلغاء إدخال البيانات في عمود معين في Excel، يمكنك استخدام حماية الورقة وتحديد الخلايا التي تريد حمايتها. يمكنك اتباع الخطوات التالية: 1. افتح ورقة العمل في Excel. 2. حدد العمود الذي تريد حمايته (على سبيل المثال، عمود D). 3. انقر بزر الماوس الأيمن على العمود المحدد واختر "تنسيق الخلايا" (Format Cells). 4. انتقل إلى علامة التبويب "الحماية" (Protection). 5. حدد خيار "قفل الخلية" (Locked). ثم، اذهب إلى: 6. انقر بزر الماوس الأيمن على علامة التبويب "الورقة" (Sheet) في أسفل النافذة. 7. اختر "حماية الورقة" (Protect Sheet). 8. ادخل كلمة مرور إذا كنت ترغب في ذلك واختر الخيارات التي تناسب احتياجاتك. بعد الانتهاء من هذه الخطوات، ستكون البيانات في العمود D محمية ولن يمكن تعديلها إلا إذا تم إلغاء حماية الورقة باستخدام كلمة المرور التي قمت بتحديدها.

وعليكم السلام. للأسف، عندما يتم تحميل ملف إكسل على Google Drive، قد يتم فقدان بعض خصائص الحماية التي قمت بها في الكمبيوتر. هذا يعود إلى طريقة عمل Google Drive وتفاعله مع ملفات Office. للتحكم بصلاحيات الوصول على Google Drive، يفضل استخدام خيارات الحماية المتوفرة على المستوى الخاص بـ Google Drive نفسه، بدلاً من الاعتماد فقط على حماية الورقة أو الخلية داخل الملف. يمكنك قفل ملفك على Google Drive من خلال اختيار الخيارات المناسبة في واجهة Google Drive. لتقديم الوصول بصورة قراءة فقط، اختار "مشاركة" ثم "حدد الذين يمكنهم الوصول" وحدد "قارئ" بدلاً من "محرر".

جرب Sub كتابة_الصدق_كل_20_صف() Dim صف As Integer Dim الصدق As String الصدق = "الصدق" ' تحديد صفوف للكتابة فيها For صف = 1 To ActiveSheet.Rows.Count Step 20 ' كتابة الكلمة في الخلية A في الصف الحالي Cells(صف, 1).Value = الصدق Next صف End Sub

جرب =SUMIFS(B:B, A:A, ">="&تاريخ_البداية, A:A, "<="&تاريخ_النهاية)

شكر وتقدير واحترام من اخيك

تسلم ايدك اخى استاذ محمد هشام. شكر وتقدير واحترام من اخيك

خالص الشكر استاذ محمد حسن المحمد اعزك الله احتاج كود لتنفيذ نظرا لكبر حجم الداتا بارك الله فيك واعزك اللهم امين يارب العالمين

السلام عليكم ورحمة الله اخوانى الافاضل كل عام وانتم بخير احتاج مساعدة بكود Vba للتجميع بدون تكرار لدينا شيتان الاول به ثلاث اعمدة الاسم والرقم القومى والمبلغ والشيت الثانى اسمه تجميع بدون تكرار احتاج كود للبحث فى عمود الرقم القومى اذا كان مكرر يجمع المبلغ بارك الله فيكم اخوانى الافاضل كود تجميع .xlsx

شكر وتقدير واحترام من اخيك

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

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

شكر وتقدير واحترام من اخيك

شكر وتقدير واحترام