ExcelFans

[清者自清]

  博客园 :: 首页 :: 博问 :: 闪存 :: 新随笔 :: 联系 :: 订阅 订阅 :: 管理 ::

在工作薄中的任意工作表中添加两个窗体按钮控件,将指定其设置 分别指定为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

posted on 2008-02-20 16:57  ExcelFans  阅读(7482)  评论(1编辑  收藏  举报