ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索

工作表中内容与选择单元格相同的单元格闪烁

已有 1602 次阅读2006-9-1 22:41 |个人分类:原创

 
'------------Public Module-------------
Enum XlFlashStyle
    xlFlashSameRow = 1'同一行
    xlFlashSameColumn = 2'同一列
    xlFlashAllUsedRange = 0'已使用范围
End Enum
 
Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As LongByVal nIDEvent As LongByVal uElapse As LongByVal lpTimerFunc As LongAs Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As LongByVal nIDEvent As LongAs Long
Public RngFlash As Range, bTimerOn As Boolean

Sub Timer_On()
bTimerOn = True
SetTimer Application.hwnd, &O1010, 1000, AddressOf OnTimer
End Sub

Sub Timer_Off()
KillTimer Application.hwnd, &O1010
bTimerOn = False
End Sub

Sub OnTimer()
If RngFlash.Interior.ColorIndex = 3 Then
    RngFlash.Interior.ColorIndex = xlNone
Else
    RngFlash.Interior.ColorIndex = 3
End If
End Sub

 
Sub SetFlashRange(ByVal sRng As Range, Optional flashstyle As XlFlashStyle = xlFlashAllUsedRange)
    Dim RngFindIn As Range
    Set rngTmp = sRng
    Select Case flashstyle
        Case xlFlashSameRow
            Set RngFindIn = sRng.Parent.Rows(sRng.Row)
        Case xlFlashSameColumn
            Set RngFindIn = sRng.Parent.Columns(sRng.Column)
        Case xlFlashAllUsedRange
        Set RngFindIn = sRng.Parent.UsedRange
    End Select
    With RngFindIn
        Set c = .Find(sRng, , xlValues, xlWhole)
            firstAddress = c.Address
            Do
                Set rngTmp = Union(rngTmp, c)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
            Set RngFlash = rngTmp
    End With
    Set RngFindIn = Nothing
    Call Timer_On
 
End Sub

Sub DisableLastFlashRange()
    If bTimerOn = True Then
        Call Timer_Off
        If Not RngFlash Is Nothing Then RngFlash.Interior.ColorIndex = xlNone
    End If
End Sub
 
 
'------------Sheet--------------------------------
Private Sub Worksheet_Deactivate()
    Call DisableLastFlashRange
End Sub

 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rngTmp As Range, c As Range
    Call DisableLastFlashRange
    If Target.Value = "" Or Target.Count > 1 Then Exit Sub
    Call SetFlashRange(Target, xlFlashSameColumn)'<---在这里修改选项
End Sub
 

路过

鸡蛋

鲜花

握手

雷人

评论 (0 个评论)

facelist

您需要登录后才可以评论 登录 | 免费注册

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 16:31 , Processed in 0.026256 second(s), 9 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

返回顶部