Question

当我选择颜色单元时，我想对其进行更改。我使用此功能，但无法支持Cell的原始颜色。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static rngcolor As Range
    If Not rngcolor Is Nothing Then rngcolor.Interior.ColorIndex = xlNone
    Set rngcolor = Target
    rngcolor.Interior.Color = vbYellow
End Sub

Answer 1

您需要存储原始颜色以及单元格参考。此外，用户可能会选择多个单元格，每个单元格都有自己的颜色。

这是处理这些复杂性的起点。请注意，这说明用户选择了> = 1个单元格的连续范围。他们还可以选择不连续的多单元格范围。为此提供了第二个更复杂的版本

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static rngcolor As Range
    Static OldColor As Variant
    Dim rw As Long, cl As Long

    If Not rngcolor Is Nothing Then
        If IsArray(OldColor) Then
            On Error GoTo NoRestore
            For rw = 1 To rngcolor.Rows.Count
                For cl = 1 To rngcolor.Columns.Count
                    If IsEmpty(OldColor(rw, cl)) Then
                        rngcolor.Cells(rw, cl).Interior.ColorIndex = xlNone
                    Else
                        rngcolor.Cells(rw, cl).Interior.Color = OldColor(rw, cl)
                    End If
                Next
            Next
            On Error GoTo 0
        Else
            If IsEmpty(OldColor) Then
                rngcolor.Interior.ColorIndex = xlNone
            Else
                rngcolor.Interior.Color = OldColor
            End If
        End If
    End If
NoRestore:
    On Error GoTo 0

    Set rngcolor = Target
    ReDim OldColor(1 To Target.Rows.Count, 1 To Target.Columns.Count)
    For rw = 1 To Target.Rows.Count
        For cl = 1 To Target.Columns.Count
            If Target.Cells(rw, cl).Interior.ColorIndex = xlNone Then
                OldColor(rw, cl) = Empty
            Else
                OldColor(rw, cl) = Target.Cells(rw, cl).Interior.Color
            End If
        Next
    Next
    rngcolor.Interior.Color = vbYellow
End Sub

版本说明不连续的范围选择

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static rngcolor As Range
    Static OldColor As Variant
    Dim OldColrRng As Variant
    Dim ar As Long, rw As Long, cl As Long

    If Not rngcolor Is Nothing Then
        If IsArray(OldColor) Then
            On Error GoTo NoRestore
            For ar = 1 To rngcolor.Areas.Count
                For rw = 1 To rngcolor.Areas(ar).Rows.Count
                    For cl = 1 To rngcolor.Areas(ar).Columns.Count
                        If IsEmpty(OldColor(ar)(rw, cl)) Then
                            rngcolor.Areas(ar).Cells(rw, cl).Interior.ColorIndex = xlNone
                        Else
                            rngcolor.Areas(ar).Cells(rw, cl).Interior.Color = OldColor(ar)(rw, cl)
                        End If
                    Next
                Next
            Next
            On Error GoTo 0
        Else
            If IsEmpty(OldColor) Then
                rngcolor.Interior.ColorIndex = xlNone
            Else
                rngcolor.Interior.Color = OldColor
            End If
        End If
    End If
NoRestore:
    On Error GoTo 0

    Set rngcolor = Target
    ReDim OldColor(1 To Target.Areas.Count)
    For ar = 1 To Target.Areas.Count
        ReDim OldColrRng(1 To Target.Areas(ar).Rows.Count, 1 To Target.Areas(ar).Columns.Count)
        OldColor(ar) = OldColrRng
    Next
    For ar = 1 To Target.Areas.Count
        For rw = 1 To Target.Areas(ar).Rows.Count
            For cl = 1 To Target.Areas(ar).Columns.Count
                If Target.Areas(ar).Cells(rw, cl).Interior.ColorIndex = xlNone Then
                    OldColor(ar)(rw, cl) = Empty
                Else
                    OldColor(ar)(rw, cl) = Target.Areas(ar).Cells(rw, cl).Interior.Color
                End If
            Next
        Next
    Next
    rngcolor.Interior.Color = vbYellow
End Sub

注意：在此代码或其他代码中，使用静态（或全局）变量很容易被错误停止。根据恢复颜色的重要性，您可能需要将Range引用和颜色存储在其他位置：例如，在（隐藏）工作表中的单元格中，（（隐藏）名称中），在外部存储库中（例如，文本或ini文件），在注册管理机构等中）或在CustomXmlPart

中

Answer 2

要使用单元格的原始颜色（根据注释）完成此操作，比在示例中将其设置回xlnone复杂得多。以下带有辅助功能的子功能可以解决任何可用的RGB颜色的问题。

Public rngcolor As Range
Public rngcolor2 As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Not rngcolor Is Nothing Then
            If Not rngcolor2 = "" Then
                If rngcolor2 = 16777215 Then
                    rngcolor.Interior.ColorIndex = xlNone
                    Else
                    rngcolor.Interior.Color = rngcolor2
                End If
            End If
    End If
    Set rngcolor = Target
    rngcolor2 = Color(Target)
    rngcolor.Interior.Color = vbYellow

End Sub

从单元格获取RGB颜色的函数：（source）

Function Color(rng As Range, Optional formatType As Integer = 0) As Variant
    Dim colorVal As Variant
    colorVal = Cells(rng.Row, rng.Column).Interior.Color
    Select Case formatType
        Case 1
            Color = Hex(colorVal)
        Case 2
            Color = (colorVal Mod 256) & ", " & ((colorVal \ 256) Mod 256) & ", " & (colorVal \ 65536)
        Case 3
            Color = Cells(rng.Row, rng.Column).Interior.ColorIndex
        Case Else
            Color = colorVal
    End Select
End Function

这会将原始单元格和原始颜色作为RGB值存储在公共变量中，并将取消选择的单元格重置为这些值。

请注意，如果一次选中多个单元格，则其内部颜色将重置为所选内容中第一个单元格的内部颜色。

还要注意，值16777215是RGB白色（默认单元颜色），等于xlNone。如果没有例外，则单元格将填充为白色，而不是重置为无颜色。如果您的单元格的颜色为白色，请忽略此步骤。

选中时更改单元格颜色，离开后返回原始颜色

2 个答案: