在工作薄中的任意工作表中添加两个窗体按钮控件,将指定其设置宏 分别指定为为ChangeColor 和 StopChange。其供示范之用
效果图:
模块中代码:
Option Explicit
Declare Function GetCursorPos _
Lib "user32" ( _
lpPoint As POINTAPI) _
As Long
Type POINTAPI
X As Long
Y As Long
End Type
Dim ChangeOn As Boolean
Dim OldRange As Range
Dim OldColorIndex As Integer
Dim blnStop As Boolean
Sub StopChange()
On Error Resume Next
If Not blnStop Then
blnStop = True
End If
End Sub
Sub ChangeColor()
Dim LngCurPos As POINTAPI
Dim NewRange As Range
On Error Resume Next
blnStop = False
If ChangeOn Then
Exit Sub
Else
ChangeOn = True
End If
Do
If blnStop = True Then Exit Do
GetCursorPos LngCurPos
On Error Resume Next
Set NewRange = ActiveWindow.RangeFromPoint(LngCurPos.X, LngCurPos.Y)
If Err <> 0 Then
OldRange.Interior.ColorIndex = OldColorIndex
Else
If NewRange.Address <> OldRange.Address Then
If OldRange Is Nothing Then
Else
OldRange.Interior.ColorIndex = OldColorIndex
End If
OldColorIndex = NewRange.Interior.ColorIndex
NewRange.Interior.ColorIndex = 3
End If
Set OldRange = NewRange
End If
On Error GoTo 0
DoEvents
Loop
ChangeOn = False
End Sub
Declare Function GetCursorPos _
Lib "user32" ( _
lpPoint As POINTAPI) _
As Long
Type POINTAPI
X As Long
Y As Long
End Type
Dim ChangeOn As Boolean
Dim OldRange As Range
Dim OldColorIndex As Integer
Dim blnStop As Boolean
Sub StopChange()
On Error Resume Next
If Not blnStop Then
blnStop = True
End If
End Sub
Sub ChangeColor()
Dim LngCurPos As POINTAPI
Dim NewRange As Range
On Error Resume Next
blnStop = False
If ChangeOn Then
Exit Sub
Else
ChangeOn = True
End If
Do
If blnStop = True Then Exit Do
GetCursorPos LngCurPos
On Error Resume Next
Set NewRange = ActiveWindow.RangeFromPoint(LngCurPos.X, LngCurPos.Y)
If Err <> 0 Then
OldRange.Interior.ColorIndex = OldColorIndex
Else
If NewRange.Address <> OldRange.Address Then
If OldRange Is Nothing Then
Else
OldRange.Interior.ColorIndex = OldColorIndex
End If
OldColorIndex = NewRange.Interior.ColorIndex
NewRange.Interior.ColorIndex = 3
End If
Set OldRange = NewRange
End If
On Error GoTo 0
DoEvents
Loop
ChangeOn = False
End Sub