عبدالفتاح في بي اكسيل

اثراء للموضوع بعدم عمل حماية Private Sub Worksheet_Change(ByVal Target As Range) Dim TT As Range Set TT = Range("A1") Set TT = Intersect(TT, Target) If Not TT Is Nothing Then Application.EnableEvents = False Application.Undo Application.EnableEvents = True MsgBox " .ليس لديك صلاحية بتغيير قيمة الخلية " End If End Sub منع تغيير قيمة خلية .xlsm

الاكسيل يلغي كامل العمود ما تطلبه مستحيل عليك وضع الرقم في خلية اخرى

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

جرب هذه المحاولة hide.xlsm

جرب هذه المحاولة لعله المطلوب print hidden first three rows.xlsm

اعتقد يتم كتابة اسم الموديول الخارجي مثلا module1

في هذه الحالة تقوم باستدعائهم على حسب اسم الماكرو عل سبيل المثال نضعهم في زر معين وليكن macro1,macro2,macro3 sub bring all macros() call macro1 call macro2 call macro3 end sub

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

جرب هذه المحاولة بمجرد الكتابة في الخلية c2 سيتم جلب البيانات غير اسماء الشيتات اجعل ورقة البيانات"data" وورقة التقرير report وضع الكود في ورقة التقرير Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("c2")) Is Nothing Then Sheets("data").Cells.AutoFilter Field:=1, Criteria1:=Target.Value Sheets("data").AutoFilter.Range.Columns("A:q").Offset(1).Copy Sheets("report").Range("A10") End If Sheets("data").AutoFilterMode = False End Sub

جرب هذه المحاولة تجهيز التجحميل.xlsm

جرب هذا التعديل الملف (1).xlsb

بما انك لا تريد رفع ملف على حسب ما فهمت منك تريد ان تضع اي قيمة تنطبق على الشرط فتقوم باخفاء الصف جرب هذا الماكرو لعله يفيدك اكتب القيمة في الخلية k2 وغير المدى الذي تريده ان ينفذ عليه Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False Dim target As String target = Range("k2").Address If Target.Address = target Then Dim cell As Range For Each cell In Range("a1:g6") If cell.Value < 50 Then cell.EntireRow.Hidden = True Else cell.EntireRow.Hidden = False End If Next cell End If Application.ScreenUpdating = True End Sub

اعتقد هذا ما تريده بدون حلقات تكرارية Sub merge() Range("j6").Formula = "'" & Join(Application.Transpose(Range("e6:e" & Range("e" & Rows.Count).End(xlUp).Row)), ", ") End Sub new.xlsm

اخي الكريم من سياستي عدم تناول اكثر من جزئية عندما تقوم بنشر سؤال وجب عليك يتوضح فيه جميع متطلباتك نبهت عليه كثير من الاعضاء هذه المرة ساتجاوز ذلك في ملفك لايوجد قيم حيث تلوين الخلايا على حسب ما فهمت اذا كان هناك قيم التي تقابل كلمة بنزين بمجرد تلوينها تريد مسح محتوياتها ضع هذا السطر r2.ClearContents اسفل r2.Interior.color = vbBlue

اكتب بنزين وسيتلون وفي حالة مسحه سيختفي اللون color.xlsm

وهل هذه مشكلة اصلا هذه موجودة في نظام الاكسيل من الاساس لا اعلم اذا كان هناك طريقة لكن اعذرني لا اجد اي فائدة مما تطلبه

بالنسبة لكود الطباعة جرب هذا Sub PrintCurr() Application.PrintOut Filename:="", Range:=wdPrintCurrentPage End Sub اما كود الحماية جرب هذا Sub pr() Dim sh As Worksheet Dim ps As String ps = "123" For Each sh In Worksheets sh.Protect Password:=ps Next sh End Sub

على حسب ما فهمت جرب هذه الدالة =max(0;a1-b1) convert negative to 0.xlsx

تاكد من اعدادات الماكرو من خلال التوثيق وارفق الملف لنرى اذا اشتغل معنا ام لا ويا ريت عندما احد الاخوة يقترح عليك حل ان ترد عليه حتى نعلم اذا حلت ام لا

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

وهذه طرق اخرى يمكن الاستفادة منها ضع الصيغة في العمود f =IF(E4<0;E4*-1;E4) وهذه طريقة اخرى ضعها في خيار المخصص ضمن خيارات التنسيق اذا اردت التطبيق على الارقام في نفس العمود حدد العمود وطبق عليها

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

جرب هذا الملف اكتب قيمة في العمود a واجعل بين القيم فراغات سيتم نسخها بالترتيب الى الورقة 2 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then If Target.Value <> "" Then LastCell = Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row Sheets("sheet2").Cells(LastCell + 1, 1).Value = Target.Value End If End If End Sub cell value.xlsm

حتى توفر عن نفسك هذا العناء كله ضع الاوراق في قائمة وربطها تفضل هذا الرابط اتمنى يفيدك https://www.extendoffice.com/documents/excel/5100-excel-create-table-of-contents.html

عفوا اين مشاركة الاستاد سليم لم تظهر لي