how to keep initial cell color, while code is hilighting active row

前端 未结 2 1940
刺人心
刺人心 2021-01-23 13:02

I have this code for workbook:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
\'toggles worksheet colors
\'code will remove         


        
相关标签:
2条回答
  • 2021-01-23 13:48

    Here's an alternate approach which makes use of the fact that Excel always "overlays" Conditional Formatting on top of whatever formatting is already on the sheet.

    Define a worksheet-level name "ROWNUM" and assign a value of 0.

    Add a conditional format using the formula =(ROW()=ROWNUM) and add whatever formatting you want to use for row highlighting.

    Your SelectionChange sub is then just:

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
         Me.Names("ROWNUM").RefersToR1C1 = "=" & Target.Cells(1).Row
    End Sub
    
    0 讨论(0)
  • 2021-01-23 13:54

    Damn, I couldn't find the Add-In but I recreated the code for you. Please note that this is not thoroughly tested. In whatever small tests that I did, it works...

    Logic:

    1. Create a hidden sheet.
    2. Store the current cell's formats in row 1 of that hidden sheet
    3. Store the currently selected row number in active sheet to cell A2 of the hidden sheet
    4. when you move to a different row then retrieve the last row number and restore it.

    Code:

    In thisWorkbook code area

    enter image description here

    Private Sub Workbook_Open()
        Dim ws As Worksheet
    
        '~~> Delete the Temp sheet we created i.e if we created
        Application.DisplayAlerts = False
        On Error Resume Next
        Sheets("MyHiddenSheet").Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
    
        '~~> ReCreate the Sheet
        Set ws = ThisWorkbook.Sheets.Add
        '~~> i am using a normal name. Chnage as applicable
        ws.Name = "MyHiddenSheet"
        '~~> Hide the sheet
        ws.Visible = xlSheetVeryHidden
    End Sub
    

    In relevant sheet code area. I am using Sheet1 as an example

    enter image description here

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        '~~> Don't do anything if multiple cells are selected
        If Target.Cells.CountLarge > 1 Then Exit Sub
    
        Dim ws As Worksheet
    
        '~~> Set our relevant sheet
        Set ws = ThisWorkbook.Sheets("MyHiddenSheet")
    
        '~~> Get the row number of the last row we had selected earlier
        '~~> For obvious reasons, this will be empty for the first use.
        If Len(Trim(ws.Cells(2, 1).Value)) <> 0 Then
            '~~> If user has moved to another row then
            '~~> Restor the old row
            If Target.Row <> Val(ws.Cells(2, 1).Value) Then
                ws.Rows(1).Copy
                Rows(ws.Cells(2, 1).Value).PasteSpecial xlFormats
            End If
        End If
    
        '~~> Copy the current row's format to the hidden sheet
        Rows(Target.Row).Copy
        ws.Rows(1).PasteSpecial xlFormats
        '~~> Store the current rows value in cell A2
        ws.Cells(2, 1).Value = Target.Row
    
        '~~> Highlight the current row in a shade of blue.
        '~~> Chnage as applicable
        With Rows(Target.Row).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent5
            .TintAndShade = 0.799981688894314
            .PatternTintAndShade = 0
            Rows(Target.Row).Select
        End With
    
        '~~> Remove the `Ants` which appear after you do a copy
        Application.CutCopyMode = False
    End Sub
    

    Screenshots:

    enter image description here

    0 讨论(0)
提交回复
热议问题