0%

Excel VBA监听单元格背景色改变事件

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

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

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

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

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

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

双击该模块,粘贴以下代码:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
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,粘贴以下代码:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
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函数即可:

1
2
3
4
5
6
7
8
9
10
11
12
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 '其他颜色则值为0undefined color, set value to 0
cell.Value = 0
End Select

End Sub