اذهب الي المحتوي
أوفيسنا

مساعده في اصلاح كود تلوين الصف


الردود الموصى بها

السلام عليكم هذا الكود يقوم بتلوين الصف عند الوقوف على الخلية 

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

Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Update 20140318
Static xRow
Static xColumn
If xColumn <> "" Then
    With Columns(xColumn).Interior
        .ColorIndex = xlNone
    End With
    With Rows(xRow).Interior
        .ColorIndex = xlNone
    End With
End If
pRow = Selection.Row
pColumn = Selection.Column
xRow = pRow
xColumn = pColumn

With Rows(pRow).Interior
    .ColorIndex = 4
    .Pattern = xlSolid
End With
End Sub

الملف المرفق 
الكود يلغي الخلايا الملونه بالاسود 

تلوين الصف.xlsm

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

السلام عليكم

جرب هذا الكود لأحد الإخوة الكرام في المنتدى:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    Const cnNUMCOLS As Long = 35
    Const cnHIGHLIGHTCOLOR As Long = 44  'default lt. yellow
    Static rOld As Range
    Static nColorIndices(1 To cnNUMCOLS) As Long
    Dim i As Long
    Application.ScreenUpdating = False
    If Not rOld Is Nothing Then 'Restore color indices
        With rOld.Cells
            If .Row = ActiveCell.Row Then Exit Sub 'same row, don't restore
            For i = 1 To cnNUMCOLS
                If nColorIndices(i) = xlNone Then
                    .Item(i).Interior.ColorIndex = xlNone
                Else
                    .Item(i).Interior.Color = nColorIndices(i)
                End If
            Next i
        End With
    End If
    Set rOld = Cells(ActiveCell.Row, 1).Resize(1, cnNUMCOLS)
    With rOld
        For i = 1 To cnNUMCOLS
            nColorIndices(i) = .Item(i).Interior.Color
            If .Item(i).Interior.ColorIndex = xlNone Then
                nColorIndices(i) = xlNone
            Else
                 nColorIndices(i) = .Item(i).Interior.Color
            End If
        Next i
        .Interior.ColorIndex = cnHIGHLIGHTCOLOR
    End With
    Application.ScreenUpdating = True
End Sub

 

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information