Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Rng As Range Set Rng = Target.Range("a1") Cells.Interior.ColorIndex = 0 '清除所有背景色 Rng.EntireColumn.Interior.ColorIndex = 40 '设置当前列颜色 Rng.EntireRow.Interior.ColorIndex = 36 '设置当前行颜色 End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Dim Rng As Range Set Rng = Target.Range("a1") Cells.Interior.ColorIndex = 0 '清除所有背景色 Rng.EntireColumn.Interior.ColorIndex = 40 '设置当前列颜色 Rng.EntireRow.Interior.ColorIndex = 36 '设置当前行颜色 End Sub
使用了这个代码后,表中的“复制”和“拷贝”功能就被禁止了,不知有无办法可以解决? 可在代码第二行(清除颜色之前就行)插入一行代码: If Application.CutCopyMode Then Exit Sub '如果处于选取状态则退出程序 代码:
复制代码 代码如下:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Application.CutCopyMode Then Exit Sub '如果处于选取状态则退出程序 Dim Rng As Range Set Rng = Target.Range("a1") Cells.Interior.ColorIndex = 0 '清除所有背景色 Rng.EntireColumn.Interior.ColorIndex = 40 '设置当前列颜色 Rng.EntireRow.Interior.ColorIndex = 36 '设置当前行颜色 End Sub