الـعيدروس

السلام عليكم الاخوة الافاضل هذا كود نفس كود الاستاذ هانكوك اخفاء المعادلات ولاكن هذا يعمل حماية لخلايا المعادلات رقم سري Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Dim rFormulaCheck As Range On Error Resume Next Sh.Unprotect Password:="123" With Selection .Locked = False .FormulaHidden = False End With If Target.Cells.Count = 1 Then If Target.HasFormula Then With Target .Locked = True .FormulaHidden = True End With Sh.Protect Password:="123", UserInterFaceOnly:=True End If ElseIf Target.Cells.Count > 1 Then Set rFormulaCheck = Selection.SpecialCells(xlCellTypeFormulas) If Not rFormulaCheck Is Nothing Then With Selection.SpecialCells(xlCellTypeFormulas) .Locked = True .FormulaHidden = True End With Sh.Protect Password:="123", UserInterFaceOnly:=True End If End If On Error GoTo 0 End Sub ينحط في حدث ThisWorkbook والسلام عليكم

السلام عليكم استاذ عادل افكارك جميله اضافة الى اكوادك المميزة تسلم وفقك الله

السلام عليكم الاخ المتدارك يمكن عمل باسورد معين ويتفعل عند اغلاق المصنف وعند الحفظ تفضل كود عمل الباس عند الاغلاق Private Sub Workbook_BeforeClose(Cancel As Boolean) Sheets("ورقة1").Protect Password:="123", UserInterFaceOnly:=True End Sub وهذا عند الحفظ بمعنى CTRL+S Private Sub Workbook_BeforeSave(ByVal SaveUI As Boolean, Cancel As Boolean) Sheets("ورقة1").Protect Password:="123", UserInterFaceOnly:=True End Sub حط الاكواد في ThisWorkbook والسلام عليكم

السلام عليكم الاستاذ عادل بارك الله فيك موضوع قيم جدا جزيت خيراً وزوجت بكراً تحياتي

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

بارك الله فيك استاذ عادل تقبل مروري تحياتي

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

السلام عليكم هذه معادلة فرضا ان الرقم في خليه a1 حط المعادلة في اي خليه اخرى =IF(A1<=10;"ممتاز";IF(A1>=11;"جيد"))

السلام عليكم عادتن الخطاء هذا ناجم من معادلة VLOOKUP هذه الصيغة ارفقها مع المعادلة التي فيها علامة N/A# =IF(ISERROR(المعادلة);"";المعادلة) واذا لم تزبط معك ارفق المعادلة تحياتي

اخي هذا الملف به فرز طباعه اذا وضحت الفكره كان بها اذا ماتريده شي اخر ارجو ارفاق ملف وبه البيانات والتوضيح تحياتي Book1.alidroos.rar

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

هذا من مرفقات الاكسل وليس فورم

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

السلام عليكم الاستاذ القدير احمد يعقوب الله يستر عليك دنيا واخره مختصرا جدا وهذا ماكان في مخيلتي من بديت طرح الموضوع فحاولت اتوصل الى حلول بغشامتي زي منت شايف كود ورقة كامله اشكرك جدا على الاضافه الجميله عندي تعديل بسيط على الكود وارجو منك التقييم هل اصبت ام لا في التعديل الكمبوكس هو عبارة عن فرز من ورقة data الى ورقة3 على حسب معيار محدد من مدى الا وهي 6 تصنيفات عند طلب تصنيف يقوم بعمل التنسيقات من الخليه المحدده وعند جلب تصنيف اخر التنسيقات الاولى موجوده في احد خلايا جلب التصنيف السابق بمعنى اضفت لكي يقوم بااسترجاع التصنيف العادي من خليه معينه في بداية الكود واخر الكود اضافتك الجميله هذا الكود Private Sub ComboBox2_Change() Sheets("data").Unprotect ("0500144134") Range("b15000").End(xlUp).Select Range("aq1").Copy Range("A" & ":AZ").PasteSpecial Paste:=xlPasteFormats Range("a3:az" & Rows.Count).ClearContents 'ClearContents Application.ScreenUpdating = False [a3: ax2000].ClearContents shtMain.[a3:az3].AutoFilter shtMain.[a3:az3].AutoFilter Field:=6, Criteria1:=ComboBox2 shtMain.Range("A4:Az2000").SpecialCells(xlCellTypeVisible).Copy Range("a3").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False shtMain.[a3:az3].AutoFilter X = Range("b15000").End(xlUp).Row + 1 Range("bd1").Copy Range("A" & X & ":AZ" & X).PasteSpecial Paste:=xlPasteFormats Cells(X, "b") = "ÇáãÌãÜÜÜÜÜæÚ" Cells(X, "c") = Application.WorksheetFunction.SUM(Range([c3], Cells(X, "c"))) Cells(X, "an") = Application.WorksheetFunction.SUM(Range([an3], Cells(X, "an"))) Cells(X, "ao") = Application.WorksheetFunction.SUM(Range([ao3], Cells(X, "ao"))) Cells(X, "aq") = Application.WorksheetFunction.SUM(Range([aq3], Cells(X, "aq"))) Cells(X, "aw") = Application.WorksheetFunction.SUM(Range([aw3], Cells(X, "aw"))) [ba1].Select End Sub وهذا الجزء المضاف في بداية الكود Range("b15000").End(xlUp).Select Range("aq1").Copy Range("A" & ":AZ").PasteSpecial Paste:=xlPasteFormats والاول والاخير هذا درس جميل جدا من سموك الكريم فتح ابواب في مخليتي من كفائة الاكسل شكرك لك تلميذك أبو نصار

اولا اعتذر للاستاذ عبدالله المجرب لم ارى مشاركتك الا بعد الرد بعد اذنك إختصار قائمة VBA لعمل كود غير طريقة ماتم شرحه بالفيديو بمعنى غير الذهاب الى قائمة المطور اظغط ALT+F11 تفضل اخي شرح فيديو شرح اظهار ورقة.rar

هنا تقنية الحلول السريعه بارك الله فيك استاذ عادل تقبل مرور تلميذك أبو نصار تحياتي

السلام عليكم هذا كود إظهار الورقة المحدده فيه بمعنى انا حطيت ورقة2 لاظهارها اذا تسمية الورقة عندك غير غير ورقة2 الى ماشئت Sub show_sheets() ورقة2.Visible = True End Sub وهذا كود اخفاء عادي Sub hide() ورقة2.Visible = xlSheetHidden End Sub وهذا اخفاء تام Sub hide_full() ورقة2.Visible = xlSheetVeryHidden End Sub وهذا مرفق يوضح كلا الطرق والسلام عليكم اظهار_اخفاء.rar

السلام عليكم استاذ احمد لا عليك احنا الذي نتعذر لاشغالك بطلبات واخذ من وقتك تفضل هذا الكود Private Sub ComboBox2_Change() Range("a3:az" & Rows.Count).ClearContents 'ClearContents Application.ScreenUpdating = False [a3: ax2000].ClearContents shtMain.[a3:az3].AutoFilter shtMain.[a3:az3].AutoFilter Field:=6, Criteria1:=ComboBox2 shtMain.Range("A4:Az2000").SpecialCells(xlCellTypeVisible).Copy Range("a3").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False shtMain.[a3:az3].AutoFilter X = Range("b15000").End(xlUp).Row + 1 Cells(X, "b") = "المجمـــــوع" Cells(X, "c") = Application.WorksheetFunction.SUM(Range([c3], Cells(X, "c"))) Cells(X, "an") = Application.WorksheetFunction.SUM(Range([an3], Cells(X, "an"))) Cells(X, "ao") = Application.WorksheetFunction.SUM(Range([ao3], Cells(X, "ao"))) Cells(X, "aq") = Application.WorksheetFunction.SUM(Range([aq3], Cells(X, "aq"))) Cells(X, "aw") = Application.WorksheetFunction.SUM(Range([aw3], Cells(X, "aw"))) [ba1].Select end sub

السلام عليكم بعد اذن اخواني الافاضل عبدالله المجرب ويحياوي اخي اطلع على المرفق عملت الماكروهات في الفورم الملف الثاني بعد تنفيذ الماكرو يختفي الفورم انشاء الله يفي بالغرض ماكروهات.rar 2ماكروهات.rar

الاخ الفاضل يحياوي هذا مافعلته وعملت تعديل عليه وزبط زي الحلاوى شاكر لك مرورك العطر

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

مشكور على التوضيح استاذي مشاركتك اكفئ وفقك الله

لم افهم ما المطلوب ارجو التوضيح

السلام عليكم تسلم الانامل استاذ جمال دغيدي تقبل مروري تحياتي

الحمد لله اعذرني على التأخير هذا حل يمكن يكون افضل من ماتوصلت اليه اللي يناسبك تفضل test.alidroos.rar