我有这个工作簿代码:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'toggles worksheet colors
'code will remove all color
'and color active row and column
If ActiveCell.Interior.ColorIndex <> xlNone Then
Cells.Interior.ColorIndex = xlNone
Else
Cells.Interior.ColorIndex = xlNone
ActiveCell.EntireRow.Interior.ColorIndex = 4
End If
End Sub
并且效果很好。但如果一行有初始颜色,它将被删除。让我知道如何
活动行将突出显示,并通过更改行,将获得其初始颜色?
该死,我找不到插件,但我为你重新创建了代码。请注意,这尚未经过彻底测试。在我所做的任何小测试中,它都有效......
Logic:
- 创建隐藏工作表。
- 将当前单元格的格式存储在该隐藏工作表的第 1 行中
- 将活动工作表中当前选定的行号存储到单元格
A2
隐藏工作表的
- 当您移动到不同的行时,检索最后的行号并恢复它。
Code:
在本工作簿代码区
![enter image description here](https://i.stack.imgur.com/5i2YC.png)
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
在相关的工作表代码区域中。我在用Sheet1
举个例子
![enter image description here](https://i.stack.imgur.com/84xmF.png)
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
截图:
![enter image description here](https://i.stack.imgur.com/3Z5ez.png)
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)