【问题标题】:Change Cell color when it selected and back original color after leaving it选择时更改单元格颜色,离开后返回原始颜色
【发布时间】:2020-02-05 11:44:01
【问题描述】:

我想在选择颜色单元格时更改它。我使用了这个功能,但我无法返回 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

【问题讨论】:

  • 你说但我不能返回单元格的原始颜色。 此代码将您留下的单元格设置为颜色索引 xlNone。你的意思是你想放回你选择之前的颜色吗?
  • 对不起,你是对的。可能是功能完全不正确。线索是将单元格的原始颜色保存在我的工作表中,其中有许多不同的颜色。

标签: excel vba


【解决方案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

【讨论】:

    【解决方案2】:

    使用单元格的原始颜色(根据 cmets)完成此操作比您在示例中所做的复杂得多(将其设置回 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。如果忽略此例外,则单元格将填充为白色,而不是重置为无颜色。如果您有特定颜色为白色的单元格,请省略此步骤。

    【讨论】:

      猜你喜欢
      • 2020-01-19
      • 1970-01-01
      • 2013-06-25
      • 2011-10-13
      • 1970-01-01
      • 2015-09-30
      • 2021-05-02
      • 2015-07-21
      • 2011-04-27
      相关资源
      最近更新 更多