在Excel 2010中导致SheetSelectionChange事件的SpecialCells

时间:2013-10-29 16:00:16

标签: excel excel-vba excel-addins vba

我有一个测试宏

Sub test()
    Dim rSrcMatrix As Range
    Set rSrcMatrix = Sheets("Code Matrix").Range("Xfer_To_Xfer_Matrix").Range("A1")
    Set rSrcMatrix = rSrcMatrix.Resize(rSrcMatrix.SpecialCells(xlCellTypeLastCell).Row, rSrcMatrix.SpecialCells(xlCellTypeLastCell).Column)     
End Sub

我正在使用此宏来测试我在VS2010中创建的 COM 插件。我已将addin中的SheetSelectionChange事件委托给某个函数。

现在我注意到,无论何时运行此宏,Excel都会激活SheetSelectionChange事件4次,而我的addin会多次调用关联的方法。

我有什么遗漏或者这是excel中的错误吗?

1 个答案:

答案 0 :(得分:1)

我相信并且我可能错了,因为我找不到MSDN文章来证明它,但是SpecialCells会执行一种选择并触发Worksheet_SelectionChangeWorkbook_SheetSelectionChange事件,因此您需要关闭事件。

这是一种测试它的简单方法。

将此代码放在工作表代码区

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    MsgBox "Damn! The SpecialCells caused me to pop up!!!"
End Sub

Sub test()
    Debug.Print ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
End Sub

Worksheet_SelectionChangeWorkbook_SheetSelectionChange做同样的工作。工作表代码中使用的Worksheet_SelectionChange用于特定工作表。如果希望事件在该工作簿中的所有工作表中触发,则使用Workbook_SheetSelectionChange

  

您的评论中的问题:如果我们想将另一个事件与该行代码相关联,该怎么办?在这种情况下,我们无法压制事件。

现在,我们有两种选择。根据您的上述问题,我们无法使用Alternative One。因此,您可以直接跳至Alternative 2

替代方案1

关闭活动

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo Whoa

    Application.EnableEvents = False

    '
    '~~> YOUR CODE
    '

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

ALTERNATIVE 2

我们不会使用SpecialCells来查找最后一行或最后一列,而是使用.Find

Sub test()
    Dim ws As Worksheet
    Dim rSrcMatrix As Range
    Dim Lrow As Long, LCol As Long

    Set ws = ThisWorkbook.Sheets("Code Matrix")

    With ws
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            Lrow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row

            LCol = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByColumns, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Column
        Else
            Lrow = 1
        End If

        Set rSrcMatrix = .Range("Xfer_To_Xfer_Matrix").Range("A1")
        Set rSrcMatrix = rSrcMatrix.Resize(Lrow, LCol)

        Debug.Print rSrcMatrix.Address
    End With
End Sub