(تمت الاجابة) عمل تنسيق شرطي بالكود

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته.

اارجو المساعدة في المرفق الشرح داخل الملف

أبو أنس

Suppliers Statment Code.rar

[أبو أنس حاجب]

للرفع

لست مستعجلاً

[طارق محمود]

السلام عليكم

الطلب الاول ان يتم الاستعاظة عن التنسيق الشرطي الموجود في الخلايا من B الى I بالتنسيق بالكود البرمجي حتى يصغر حجم الملف

ليس هذا هو السبب

تم علاج ذلك في الكود

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

تم علاج ذلك أيضا في الكود

تفضل الكود أستبدله بالذي عندك

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Application.DisplayAlerts = False


ActiveSheet.Unprotect

If Target.Column <> 2 Or Target.Row < 2 Then Exit Sub

If Target.Count <> 1 Then

    For Each ce In Target

	    If ce.Value = "" Then Range(ce.Offset(0, 1), ce.Offset(0, 9)).ClearContents

    Next ce

    Exit Sub

End If

If Target.Value = Empty Then Range(Target.Offset(0, 1), Target.Offset(0, 9)).Value = Empty: Exit Sub

If Not Intersect(Target, Range("b2:b60000")) Is Nothing Then

Target.Offset(0, 9).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC[-9],list,2,FALSE)),"""",VLOOKUP(RC[-9],list,2,FALSE))"


ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

	    , AllowFiltering:=True


Exit Sub

End If


Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

Application.DisplayAlerts = True


End Sub

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته,,

أستااذي الفاضل طارق حفظك الله

دائما اكون في موقف العاجز عن الرد وباي العبارات التي تستخقونها من التقدير والثناء والاحترام.

ولكن جزاكم عند الله وهو الكريم ذو الفضل

أبو أنس

ولإسمك معزة اخرى فهو اسم لأخي الله يرحمه.

[abouelhassan]

استاذنا المهندس طارق

روائع الروائع

كل الاحترام من القلب وخالص الدعاء

بارك الله فيك وبك ولك