Excel VBA - 有没有办法在一张纸上有多个范围允许不同的双击事件?

时间:2016-08-06 12:15:09

标签: excel vba excel-vba

我正在尝试在Excel 2010中创建一个虚拟调度板。我有一个编码区域,因此员工只需右键单击一个单元格将其变为绿色,然后双击将其变回红色。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("ColorRange")) Is Nothing Then
Cancel = True
Target.Interior.ColorIndex = 3
End If
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("ColorRange")) Is Nothing Then
Cancel = True
Target.Interior.ColorIndex = 4
End If
End Sub

我想在同一张纸上添加不同的范围,以便能够使用相同的功能但颜色不同。这甚至可能吗?

非常感谢任何可能的帮助,谢谢,

3 个答案:

答案 0 :(得分:4)

我建议这样:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    dim newColor: newColor = null
    If Intersect(Target, Range("ColorRange")) Then newColor = 3
    If Intersect(Target, Range("SomeRange2")) Then newColor = 4
    If Intersect(Target, Range("SomeRange3")) Then newColor = 5
    if not isnull(newColor) then Cancel = True: Target.Interior.ColorIndex = newColor
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    dim newColor: newColor = null
    If Intersect(Target, Range("ColorRange")) Then newColor = 6
    If Intersect(Target, Range("SomeRange2")) Then newColor = 7
    If Intersect(Target, Range("SomeRange3")) Then newColor = 8
    if not isnull(newColor) then Cancel = True: Target.Interior.ColorIndex = newColor
End Sub

答案 1 :(得分:0)

工作表的多个双击事件

Luis Siquot有正确的方法。但是,您可以使用WithEvents进行多次双击事件是正确的答案。

Private WithEvents WorksheetWatcher As Worksheet


Private Sub Worksheet_Activate()

    Set WorksheetWatcher = Me

End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("ColorRange")) Is Nothing Then
        Cancel = True
        Target.Interior.ColorIndex = 3
    End If
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("ColorRange")) Is Nothing Then
        Cancel = True
        Target.Interior.ColorIndex = 4
    End If
End Sub

' WorksheetWatcher


Private Sub WorksheetWatcher_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("ColorRange2")) Is Nothing Then
        Cancel = True
        Target.Interior.ColorIndex = 5
    End If
End Sub

Private Sub WorksheetWatcher_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("ColorRange2")) Is Nothing Then
        Cancel = True
        Target.Interior.ColorIndex = 6
    End If
End Sub

答案 2 :(得分:0)

通过对范围使用表单控件,您可能会遇到不同的事件,但这样会很难修改单元格并查找单击的范围。

您可以将重复代码放入函数中。我无法测试代码,只是为了表明这个想法:

DoubleClickColors = [{1,2,3}]  ' Variant(1 To 3)
 RightClickColors = [{4,5,6}]
Dim colorAreas As Areas

Private Function check(ByVal Target As Range, colors) As Boolean ' False by default
    check = False ' optional
    if colorAreas Is Nothing Then Set colorAreas = Range("ColorRange,ColorRange2,ColorRange3").Areas ' or one named range with multiple areas

    For i = 1 to colorAreas.Count
        If Not Intersect(Target, colorAreas(i)) Is Nothing Then
            Target.Interior.ColorIndex = colors(i)
            check = True
            Exit Function
        End If
    Next
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = check(Target, DoubleClickColors)
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = check(Target, RightClickColors)
End Sub