احمد بدره

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

قم بعمل حفظ الملف باسم واختر نوع الحفظ مصنف به وحدات ماكرو ممكنة

خطوات نسخ فورم إلى ملف آخر افتح الملف الذي به الفورم ثم اضغط مفتاح Alt+F11 يظهر محرر الأكواد اذهب إلى Forms ثم اختر اسم الفورم المراد نسخه ثم اضغط كليك يمين فوقه يظهر قائمة اتبع الخطوات الموجود بالمرفق بعط الخطوة رقم 2 قم بفتح الملف المراد نقل الفورم إليه ثم أكمل باقي الخطوات

أولاً عذرًا كان الملف شئون العاملين2 كان يحتاج تعديلات في أوامر الطباعة فقمت بإصلاحها ففكرت أنك تريد إصلاح هذه المشكلات ثانيًا تفضل المرفق المطلوب وبالنسبة للخطوات سوف أكتبها لك لاحقًا برنامج شئون عاملين 2020.rar

تم عمل المطلوب جرب الملف وأعطنى ملاحظاتك شئون العاملين2.rar

أعتقد أن يكون هذا هو المطلوب Book111.xls

أرفق الملف الذي به هذا النموذج

عذرًا فقد حدث سهوًا مني نظرًا لصعوبة المطلوب تفضل الملف لعله يفي بالغرض Book111.xls

تفضل المرفق لعله يكون المطلوب Book111.xls

اعتقد أن السبب هناك معادلات في ورقة العمل المسماه بالجمع في الأعمدة j وN و W تحتاج تعديل وكذلك العمود c في ورقة العمل زيادة2017 والأعمدة o و Rو S في ورقة العمل منحة أضحى2017م

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

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

ممكن تجرب هذه الطريقة نفترض ان هناك خلايا بها بيانات أولاً قم بعمل حماية لورقة العمل أو كل أوراق العمل اذهب إلى محرر الأكواد بالضغط على مفتاح Alt+F11 قم بإدراج موديول والصق هذان الكودان فيه Public Sub Ali_Prodc() Dim Sh As Worksheet Dim Rng As Range Ch_P On Error Resume Next With Application .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False For Each Sh In ThisWorkbook.Worksheets If Sh.ProtectContents = True Then Sh.Unprotect Password:="123": Sh.Cells.Locked = False If Not Sh.Cells.HasFormula Then Sh.Cells.Locked = False Else Sh.Cells.FormulaHidden = True With Sh.Cells .SpecialCells(2).Locked = True .SpecialCells(-4123).Locked = True End With If Sh.Cells(1, "IV") = "True" Then Sh.Protect Password:="123" Next .EnableEvents = True .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub Private Sub Ch_P() Dim Sn As Worksheet For Each Sn In ThisWorkbook.Worksheets If Sn.ProtectContents = True Then Sn.Unprotect Password:="123": Sn.Cells(1, "IV") = "True": Sn.Protect Password:="123" Next End Sub بعد كتابة ما تريده قم بتشغيل الماكرو Ali_Prodc بذلك تكون ورقة العمل أو المصنف بالكامل ( أي خلية بها بيانات ) محمية مع إمكانية الكتابة في الخلايا الأخرى وللتعديل على أي خلية بها بيانات قم بعمل إلغاء حماية

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

يجب إرفاق ملف الإكسيل مع ملف الوورد والأفضل تقوم بضغهم وتجمعيهم ببنرامج وين رار حتى نتمكن من تنفيذ طلبك

ممكن يكون هذا هو المطلوب مخازن.xlsx

اتبع الخطوات التي بالصورة

جرب هذه المعادلة لعلها تفي بالغرض مخازن.xlsx

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

من قائمة مراسلات اضغط على بدء دمج المراسلات ثم اجعل نو ع المستند دليل

أهلاً بك في هذا المنتدى

بعد إذن أستاذنا الفاضل اضغط كليك يمين على ورقة العمل Print_sheet يظهر صندوق حواري كما بالشكل 1 والشكل رقم 2 طريقة جعل الماكرو يعمل تلقائيًا

بعد إذن أستاذنا الكبير زيزو تم تعديل بسيط في الكود تفضل المرفق المصنف1(4).xlsx

ممكن تجرب هذا التعديل لعله يكون المطلوب بالضبط Sub Macro01() a = MsgBox("هل تريد طباعة الان ؟", vbYesNo + vbQuestion, "طباعة") ' اذ اخترت لا اريد الطباعة الصحيح الكود يقف ويلغي التنفيذ هنا If a = vbNo Then Exit Sub End If 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

بعد إذن الأستاذ سليم اكتب 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