كود تلوين الصف النشط

[dodo222]

السلام عليكم

من فضلكم عندي ملف لتنقيط الطلاب

اريد تنسيق يلون لي السطر الذي اضغط علية من فضلكم

وعندما اختار سطر اخر يتحول التنسيق الى السطر الاخر

example 33.xlsx

[سليم حاصبيا]

جرب هذا الكود في الملف المرفق

Option Explicit

Sub Colrorize()
 Dim i%, arr(1 To 10)
 Dim my_rg As Range
 Set my_rg = Range("a10").CurrentRegion
  For i = 1 To 10
   arr(i) = Cells(10, i).Interior.ColorIndex
   Next
  For i = 1 To 10
  my_rg.Columns(i).Interior.ColorIndex = arr(i)
  Next
End Sub
Rem]]]]]]]]]]]]]]]]]]]]]]]]]]
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  With Application
     .ScreenUpdating = False
     .EnableEvents = False
  End With
  Dim st: st = Target.Address
 Dim Change_range As Range
 Set Change_range = Range("a10").CurrentRegion
  If Not Intersect(Target, Change_range) Is Nothing Then
    Colrorize
   Cells(Target.Row, 1).Resize(, 10).Interior.ColorIndex = 6
 End If
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
  End With
 End Sub

 

Color_sa.xlsm

[dodo222]

شكرا اخي سليم

جربت الكود في الملف الثاني لم ينجح معي اين المشكل

تفضل الملف

دفترالتنقيط.xlsx

[سليم حاصبيا]

قلت لك جرب هذا الكود في الملف المرفق

لان الملف الذي رفعته لك غير الملف الذي ارسلته انت (جاول المقارنه بين الملفين واكتشف بنفسك المشكل)

بغير هذه الطريقة لا يمكن التعلم

[Ali Mohamed Ali]

أحسنت أستاذ سليم كود رائع جعله الله في ميزان حسناتك

أخى الكريم dodo لا يمكنك التعلم الا اذا استجبت لكل هذه النصائح من اساتذتنا الكبار أمثال الأستاذ الكبير سليم حاصبيا

له منا كل المحبة والإحترام

[dodo222]

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

[dodo222]

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

[سليم حاصبيا]

جرب هذا الكود في كل من الملفين (يمكن ان يكون مفتاج الحل) و تكتشف الفرق

Sub difference()
Dim my_rg As Range
 Set my_rg = Range("a10").CurrentRegion
 my_rg.Select
End Sub

 

[shehab elgar7i]

تفضل استاذي العزيز جرب هذا الملف عله يفي بالغرض

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

تقبل تحياتي

 

 

example 33.xlsm