احمد بدره

بعد إذن الأستاذ سليم اكتب Next في سطر قبل End sub ليصبح الكود Sub Click3() Application.ScreenUpdating = False On Error GoTo 1 Dim ws As Worksheet: Set ws = Sheets("add") Dim N, C2 As Range Dim I% ' On Error Resume Next For Each N In ws.Range("H6:H" & ws.Range("B" & Rows.Count).End(xlUp).Row) If N.Value = "محمود" Or N.Value = "احمد" Then For I = 111 To 256 If I = 117 Or I = 164 Or I = 183 Then I = I + 1 If I = 180 Then I = I + 2 N.Offset(0, I) = vbNullString Next End If N.Offset(0, 165) = Format(Round(N.Offset(0, 180) + N.Offset(0, 181), 2)) Application.ScreenUpdating = True Next 1 End Sub

تم تعديل المطلوب المصنف1(3)(1).xlsx

تفضل المطلوب المصنف1(3).xlsx

جرب هذا التعديل ربما يكون ما تريده Sub Macro01() a = MsgBox("هل تريد طباعة الان ؟", vbYesNo + vbQuestion, "طباعة") ' اذ اخترت لا اريد الطباعة الصحيح الكود يقف ويلغي التنفيذ هنا If a = vbYes Then With ActiveSheet Dim Numcop As Integer Numcop = Application.InputBox("أدخل عدد النسخ للطباعة:", "كم عدد النسخ?", 1, Type:=1) If Numcop = 0 Then Exit Sub ElseIf Len(Numcop) > 0 Then End If a = MsgBox("هل تريد طباعة الان ؟", vbYesNo + vbQuestion, "طباعة") If a = vbNo Then Exit Sub Else ActiveWindow.SelectedSheets.PrintOut copies:=Numcop 'اذ اخترت لا اريد الطباعة عدد الصحيح الكود يقف ويلغي التنفيذ كذالك هنا End If End With End If Dim X3 As Long, X4 As Long X3 = Sheets("DATA").Range("a1000").End(xlUp).Row + 1 X4 = Sheets("aaa").Range("B24").End(xlUp).Row Sheets("DATA").Range("B" & X3).Resize(X4 - 5, 21) = Sheets("aaa").Range("B6").Resize(X4 - 5, 21).Value End Sub

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

قم بنقل هذا الكود Application.ScreenUpdating = False في صدر الماكرو بعد On Error GoTo 1 فأعتقد يكون أسرع

قم بتجربة هذا التعديل على كود حضرتك وأتمنى من الله أن يكون هذا هو المطلوب Sub Macro01() a = MsgBox("هل تريد طباعة الان ؟", vbYesNo + vbQuestion, "طباعة") ' اذ اخترت لا اريد الطباعة الصحيح الكود يقف ويلغي التنفيذ هنا If a = vbYes Then With ActiveSheet Dim Numcop As Integer Numcop = Application.InputBox("أدخل عدد النسخ للطباعة:", "كم عدد النسخ?", 1, Type:=1) If Numcop = 0 Then Exit Sub ElseIf Len(Numcop) > 0 Then End If ActiveWindow.SelectedSheets.PrintOut copies:=Numcop 'اذ اخترت لا اريد الطباعة عدد الصحيح الكود يقف ويلغي التنفيذ كذالك هنا End With End If Dim X3 As Long, X4 As Long X3 = Sheets("DATA").Range("a1000").End(xlUp).Row + 1 X4 = Sheets("aaa").Range("B24").End(xlUp).Row Sheets("DATA").Range("B" & X3).Resize(X4 - 5, 21) = Sheets("aaa").Range("B6").Resize(X4 - 5, 21).Value End Sub

جرب هذا الكود لعله يفي بالغرض في حالة الوافقة يظهر صندوق حواري لكتابة رقم أول صفحة في الطباعة اكتب رقم البداية ثم اضغط ok يظهر صندوق حواري لكتابة رقم آخر صفحة في الطباعة اكتب رقم النهاية ثم اضغط ok Sub طباعةمدىمن_الصفحات() A = MsgBox("هل تريد طباعة الان ؟", vbYesNo + vbQuestion, "طباعة") ' اذ اخترت لا اريد الطباعة الصحيح الكود يقف ويلغي التنفيذ هنا If A = vbYes Then Dim startpage As Integer Dim endpage As Integer startpage = InputBox("من فضلك أدخل رقم أول صفحة المراد طباعتها.", " رقم أول صفحة في الطباعة") If Not WorksheetFunction.IsNumber(startpage) Then MsgBox "Invalid Start Page number. Please try again.", "Error" Exit Sub End If endpage = InputBox("من فضلك أدخل رقم آخر صفحة المراد طباعتها.", "رقم آخر صفحة في الطباعة ") If Not WorksheetFunction.IsNumber(endpage) Then MsgBox "Invalid End Page number. Please try again.", "Error" Exit Sub End If ActiveWindow.SelectedSheets.PrintOut From:=startpage, To:=endpage, Copies:=1, Collate _ :=True End If Dim X3 As Long, X4 As Long X3 = Sheets("DATA").Range("a1000").End(xlUp).Row + 1 X4 = Sheets("aaa").Range("B24").End(xlUp).Row Sheets("DATA").Range("B" & X3).Resize(X4 - 5, 21) = Sheets("aaa").Range("B6").Resize(X4 - 5, 21).Value End Sub

تفضل الشرح في المرفق وإليك الملف مجمع تجميع الملفين.rar

اتبع الخطوات التي بالمرفق ربما تأتي بالحل

تفضل الملف بعد التعديل ليفتح لك على صفحة الفاتورة وتقوم بتشغيل الفورمة من الزر الذي قمت بعمله امكانية ادخال البيانات والفورمة ظاهرة.rar

يجب عند نسخ الكود أن تختار اللغة العربية أولا في شريط المهام ثم قم بالنسخ واللصق تفضل الكود مع ملاحظة أن المعاينة والطباعة لموظف واحد فقط Sub PrintAll() Dim LastR As Integer Sheets("بيانات اساسية").Select LastR = Sheets("بيانات اساسية").Cells(Rows.Count, "B").End(xlUp).Row Range("B6:B" & LastR).Select x = Application.WorksheetFunction.CountA(Selection) Sheets("مفردات").Select Range("A6").Select Selection.ClearContents For I = 1 To x Range("A6") = I ActiveWindow.SelectedSheets.PrintPreview Next I End Sub

يوجد خطأ في كتابة التاريخ بعمود تاريخ الزيارة بالرقم 8 في الشيتين مكتوب هكذا 5/15/2018 والصحيح 15/05/2018 قم بالتعديل وجربها أيضًا على الفورم ربما يكون هذا هو الخطأ

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

كلمة المرور : 12345

من فضلك اتبع الخطوات التي في الصورة الشكل رقم 1 في الملف القديم وباقي الأشكال تتبع في الملف الجديد مع خالص تحياتي

تم تعديل الكود ليتناسب مع كل الأعمدة ابتداءًا من العمودM إلى العمودCV كل ما عليك هو وضع رقم الدرجة للنهاية الصغرى في الصف رقم 9 للأعمدة المطلوب وضع دوائر لها الشرط الثاني لوضع الدوائر هو أن يكون نطاق خلايا العمود c في الصفوف غير فارغ -1استبدال التظليل بدوائر حمراء.xlsm

تسلم الأنامل

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

تفضل المرفق وكود لإضافة سطر فارغ في الملف استبدال التظليل بدوائر حمراء.xlsx

تفضل الملف المرفق لعله يفي بالغرض Picture Lookup.xlsx

اتبع خطوات المرفق

تفضل المرفق أخي الفاضل ويمكن أن تغير النسبة المئوية كما تريد Microsoft Office Excel Worksheet جديد _(3)_.rar

قم بإيقاف هذا السطر وذلك بوضع علامة التنصيص " أو قم بحذفه فباقي الأكواد تعمل بدونه وتعUserform.xlsطي النتيجة المطلوبة

ممكن بهذه الطريقة معادلة جمع.xlsx