vue改变单元格颜色_Excel VBA监听单元格背景色改变事件

熟悉Excel的朋友都知道Excel有一个条件格式功能，当单元格值满足预设条件时，自动套用单元格格式。但是如果反过来需要根据单元格格式(尤其是单元格颜色)来改变单元格值时，该怎么做呢？

事实上，目前并没有一个简单的方案来满足这个需求，我们需要通过VBA宏来实现。

首先，需要将“开发工具”激活以使用VBA。在Excel选项的“自定义功能区”中，勾选“开发工具”。

在工具栏中会多出开发工具标签

点击Visual Basic，打开VBA界面。右击VBAProject，选择“插入” – “类模块”

选择该模块，在下方的属性中将名称修改为C_CellColorChange

双击该模块，粘贴以下代码：

Option Explicit
Private WithEvents cmb As Office.CommandBars
Private bCancel As Boolean
Private bAllCellsCounted As Boolean
Private vCellCurColor() As Variant
Private vCellPrevColor() As Variant
Private sCellAddrss() As String
Private sVisbRngAddr As String
Private i As Long
Private oSh As Worksheet
Private oCell As Range

Public Sub ApplyToSheet(Sh As Worksheet)
    Set oSh = Sh
End Sub

Public Sub StartWatching()
    Set cmb = Application.CommandBars
End Sub

Private Sub Class_Initialize()
    bAllCellsCounted = False
End Sub


Private Sub cmb_OnUpdate()

    If Not ActiveSheet Is oSh Then Exit Sub
    bCancel = False
    i = -1
VisibleRngChanged:
    If sVisbRngAddr <> ActiveWindow.VisibleRange.Address _
        And sVisbRngAddr <> "" Then
        Erase sCellAddrss
        Erase vCellCurColor
        Erase vCellPrevColor
        sVisbRngAddr = ""
        bAllCellsCounted = False
        GoTo VisibleRngChanged
    End If
    On Error Resume Next
        For Each oCell In ActiveWindow.VisibleRange.Cells
            ReDim Preserve sCellAddrss(i + 1)
            ReDim Preserve vCellCurColor(i + 1)
            sCellAddrss(i + 1) = oCell.Address
            vCellCurColor(i + 1) = oCell.Interior.Color
            If vCellPrevColor(i + 1) <> vCellCurColor(i + 1) Then
                If bAllCellsCounted = True Then
                    oCell.Interior.Color = vCellPrevColor(i + 1)
                    CallByName ThisWorkbook, _
                    "CellColorChanged", VbMethod, oCell, _
                    oCell.Interior.Color, vCellCurColor(i + 1), bCancel
                    If Not bCancel Then
                        oCell.Interior.Color = vCellCurColor(i + 1)
                        vCellPrevColor(i + 1) = vCellCurColor(i + 1)
                    Else
                        oCell.Interior.Color = vCellPrevColor(i + 1)
                        vCellCurColor(i + 1) = vCellPrevColor(i + 1)
                    End If
                    bCancel = False
                End If
            End If
                i = i + 1
            If i + 1 >= ActiveWindow.VisibleRange.Cells.Count Then
                bAllCellsCounted = True
                ReDim Preserve vCellPrevColor(UBound(vCellCurColor))
                vCellPrevColor = vCellCurColor
            End If
            vCellPrevColor(i + 1) = vCellCurColor(i + 1)
        Next
    On Error GoTo 0
        sVisbRngAddr = ActiveWindow.VisibleRange.Address

End Sub

双击ThisWorkbook，粘贴以下代码：

Option Explicit
Private oCellColorMonitor As C_CellColorChange

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopWatching
End Sub

Private Sub Workbook_Open()
    Call StartWatching(ActiveSheet)
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
 Call StartWatching(Sh)
End Sub

Public Sub CellColorChanged(Cell As Range, PrevColor As Variant, NewColor As Variant, Cancel As Boolean)
    
    MsgBox (NewColor)

End Sub


Private Sub StartWatching(ByVal Sh As Object)
    Set oCellColorMonitor = New C_CellColorChange
    oCellColorMonitor.ApplyToSheet Sh
    oCellColorMonitor.StartWatching
End Sub

Private Sub StopWatching()
    Set oCellColorMonitor = Nothing
End Sub

回到Excel，现在当我们更改任意一个单元格背景色的时候，都会提示背景色的颜色值

现在，我们就可以根据自己的需求来扩展脚本了。比如，当单元格颜色为黑色时，值为-1；当颜色为红色时，值为1。只需要修改ThisWorkbook的代码中的CellColorChanged函数即可：

Public Sub CellColorChanged(cell As Range, PrevColor As Variant, NewColor As Variant, Cancel As Boolean)
    
    Select Case NewColor
        Case "0":   '黑色|Black
            cell.Value = -1
        Case "255":   '红色|Red
            cell.Value = 1
        Case Else   '其他颜色则值为0|undefined color, set value to 0
            cell.Value = 0
    End Select

End Sub