我正在尝试在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
我想在同一张纸上添加不同的范围,以便能够使用相同的功能但颜色不同。这甚至可能吗?
非常感谢任何可能的帮助,谢谢,
答案 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)
工作表的多个双击事件
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