Excel-事件（Workbook、Worksheet、Range、OnKey/OnTime）

  

一、Excel事件介绍

 Excel事件就是一个能被对象识别的操作。

当某个事件发生后自动运行的过程称为事件过程。事件过程也是Sub过程。

实践过程必须写在特定对象所在的模块中，而且只有过程所在的模块里的对象才能触发这个事件。

事件过程名由Excel自动设置，以“对象名称_事件名称”的形式存在，不能更改。 

二、Worksheet事件

Worksheet事件是发生在Worksheet对象里的事件。事件过程必须写在对应的Worksheet对象里，只有过程所在的Worksheet对象里的操作才能触发该事件。

1、Worksheet_Change事件：自动提示更改的内容 

Private Sub Worksheet_Change(ByVal Target As Range)    '入参中Target代表被选中的单元格
    Application.EnableEvents = False '禁用事件
    If Target.Column = 1 Then
        MsgBox Target.Address & "单元格的值被修改为：" & Target.Value
    End If
    Application.EnableEvents = True '启用事件
End Sub

2、Worksheet_SelectionChange事件：你选中了谁

 可以用此事件来记录Excel单元格修改前的旧值。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim oldvalue As String
    MsgBox "当前选中的单元格区域为：" & Target.Address
    oldvalue = Target.Value
    
    If Target.Column <> 1 Then
        Cells(Target.Row, "A").Select
    End If
End Sub

3、Worksheet_Activate事件：自动提示工作表名 

Private Sub Worksheet_Activate()
    MsgBox "当前活动工作表为：" & ActiveSheet.Name
End Sub

4、Worksheet_Deactivate事件：禁止选中其他工作表 

Private Sub Worksheet_Deactivate()
    MsgBox "不允许选中" & ActiveSheet.Name & "工作表外的其他工作表"
    Worksheets("Sheet1").Select
End Sub

5、Worksheet事件列表

Worksheet对象一共有9个事件可供使用。 

 

三、Workbook事件

 Workbook事件是发生在Workbook对象里的事件，进入VBE后可以看到ThisWorkbook模块。这个模块专门用来保存Workbook对象的事件过程，Workbook对象的事件过程只有保存在这个模板里才能被Excel识别

1、OPen事件

 Workbook_Open事件告诉Excel，当打开工作簿时自动运行程序。

Private Sub Workbook_Open()
    Worksheets(1).Select
End Sub 

2、BeforeClose事件 

每次关闭工作簿都会自动运行程序

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    '判断用户单击对话框中的哪个按钮，如果按下的是【否】，则修改参数的值为True
    If MsgBox("你确定要关闭工作簿吗？", vbYesNo) = vbNo Then
        '变量Cancel是程序参数，如果为True，则取消关闭工作簿
        Cancel = True '取消关闭
    End If
End Sub 

3、Workbook_SheetChange事件

 当工作簿里任意一个单元格被更改时，自动运行程序。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    '这里入参Sh代表发生更改的单元格所在的工作表，Target表示被更改的单元格
    MsgBox "当前更改的工作表为：" & Sh.Name & Chr(13) & _
            "发生更改的单元格地址为：" & Target.Address
End Sub 

4、Workbook事件列表

  

四、其他事件

1、MouseMove事件

　　 当鼠标指针移动到按钮上时，按钮迅速闪开。鼠标和按钮就像老鹰捉小鸡游戏，这样的效果可以用MouseMove实现。

　　添加一个按钮：通过“视图”——“工具栏”——“控件工具箱”添加，或者通过“开发人员选项”——“插入”——“ActiveX控件”——“命令按钮”

　　右键按钮查看代码（修改按钮上文字通过Caption属性修改），编辑按钮和完成事件逻辑

'MouseMove事件告诉Excel，当鼠标指针在cmd按钮上移动是自动运行程序
Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim l As Integer, t As Integer
    l = Int(Rnd() * 10 + 125) * (Int(Rnd() * 3 + 1) - 2) '生成随机数
    t = Int(Rnd() * 10 + 30) * (Int(Rnd() * 3 + 1) - 2)
    CommandButton1.Top = CommandButton1.Top + t '重新设置改按钮的top属性值
    CommandButton1.Left = CommandButton1.Left + l '重新设置改按钮的left属性值
End Sub

如果按钮跑远了，可以通过另外按钮Click事件设置参数

Private Sub CommandButton2_Click()
    CommandButton1.Top = 15
    CommandButton1.Left = 160
End Sub

2、不是事件的事件-Application对象的OnKey方法

除了对象的事件，Application对象还有两种方法，可以像事件一样让程序自动运行，分别是OnKey和OnTime 

OnKey方法告诉Excel，当在键盘上按下指定键或组合键时自动运行程序。

运行ok过程，返回工作表按下Shift+e组合键即可自动运行Test

Sub ok()
    Application.OnKey "+e", "test" '当按下Shift+e组合键时，运行参test过程
End Sub
Sub Test()
    MsgBox "你好，我在学习OnKey方法"
End Sub

3、不是事件的事件-Application对象的OnTime方法

 OnTime方法告诉Excel，当到指定的时间时自动运行程序（可以是指定的某个时间，也可以是指定的某个时间之后）

Sub ot()
    '一个小时后，自动运行Test过程
    Application.OnTime Now() + TimeValue("01:00:00"), "test"
End Sub

Sub Test()
    MsgBox "你好，你已经连续工作一个小时了，请注意休息！"
End Sub

　　无论是OnKey还是OnTime想要让指定程序自动运行，都必须先运行该方法所在的程序，如果不运行ok或ot过程，指定的Test都不会自动运行。

　　如果想省去手动执行ok和ot的步骤，可以在ThisWorkbook增加如下事件过程：　　

Private Sub Workbook_Open()
    Call ok '运行ok过程
    Call ot '运行ot过程
End Sub

五、事件实例

1、一举多得，快速录入数据

逻辑说明：
1、通过工作表的Change事件触发
2、如果C3:C65536为空，或者修改单元格数量大于1，则退出事件
3、读取“I”列数据，从第3行开始循环，读取非空数值
4、如果输入的值等于I列里的值，则进入处理逻辑
5、禁止事件，防止将字母更改为商品名称时，再次执行程序
6、目标单元格写入“产品名称”
7、目标单元格向左移动一格，写入“销售日期”
8、目标单元格向右移动一格，写入“商品代码”
9、目标单元格向右移动二格，写入“商品单价”
10、目标单元格向右移动三个，获取焦点（选中），等待输入“销售数量”
11、重启事件并退出事件
12、循环递增

Private Sub Worksheet_Change(ByVal Target As Range)
    '如果更改的单元格不是C列第3行以下的单元格或更改的单元格个数大于1时退出程序
    If Application.Intersect(Target, Range("C3:C65536")) Is Nothing Or Target.Count > 1 Then
        Exit Sub
    End If
    Dim i As Integer
    i = 3 '参照表中第1条记录在第3行，所以初始值设置为3
    Do While Cells(i, "I").Value <> ""
        If UCase(Target.Value) = Cells(i, "I").Value Then
            Application.EnableEvents = False '禁用事件，防止将字母改为商品名称时，再次执行程序
            Target.Value = Cells(i, "i").Offset(0, 1).Value '写入产品名称
            Target.Offset(0, -1).Value = Date '设置销售日期
            Target.Offset(0, 1) = Cells(i, "I").Offset(0, 2).Value '写入商品代码
            Target.Offset(0, 2) = Cells(i, "I").Offset(0, 3).Value '写入商品单价
            Target.Offset(0, 3).Select '选中销售数量列，等待输入销售数量
            Application.EnableEvents = True '重新启用事件
            Exit Sub
        End If
        i = i + 1
    Loop
End Sub

功能：在C列录入内容对应I列内容时，自动匹配其相关信息，更新销售日期，并把光标选中F列，等待输入销售数量。

2、我该监考哪一场

逻辑说明：
1、使用SelectionChange事件。
2、清除B3:Q22区域内所有单元格底纹颜色。
3、如果同时选中多个单元格，将选中区域内的第一个单元格赋值给Targer。
4、当选中的单元格不在区域B3:Q22时，退出事件。
5、遍历区域B3:Q22如果有值等于选中的单元格值，则突出显示。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Range("B3:Q22").Interior.ColorIndex = xlNone '清除单元格里原有底纹颜色
    '当选中的单元格个数大于1时，重新给Target赋值
    If Target.Count > 1 Then
        Set Target = Target.Cells(1)
    End If
    '当选中的单元格不包含指定区域的单元格时，退出程序
    'Intersect方法返回参数指定的多个单元格的公共区域。参数至少是两个Range对象
    If Application.Intersect(Target, Range("B3:Q22")) Is Nothing Then
        Exit Sub
    End If
    Dim rng As Range
    For Each rng In Range("B3:Q22")
        If rng.Value = Target.Value Then
            rng.Interior.ColorIndex = 39
        End If
    Next
End Sub

功能：光标选中单元格时，区域内跟单元格值一样的都会突出显示。

  

逻辑说明：
1、使用SelectionChange事件。
2、清除B3:Q22区域内所有单元格底纹颜色。
3、如果同时选中多个单元格，将选中区域内的第一个单元格赋值给Targer。
4、当选中的单元格不在区域B3:Q22时，退出事件。
5、突出（底纹）标志选中的单元格的行和列

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Range("B3:Q22").Interior.ColorIndex = xlNone '清除单元格里原有底纹颜色
    '当选中的单元格个数大于1时，重新给Target赋值
    If Target.Count > 1 Then
        Set Target = Target.Cells(1)
    End If
    '当选中的单元格不包含指定区域的单元格时，退出程序
    'Intersect方法返回参数指定的多个单元格的公共区域。参数至少是两个Range对象
    If Application.Intersect(Target, Range("B3:Q22")) Is Nothing Then
        Exit Sub
    End If
'    Dim rng As Range
'    For Each rng In Range("B3:Q22")
'        If rng.Value = Target.Value Then
'            rng.Interior.ColorIndex = 39
'        End If
'    Next
    '添加底纹颜色
    Range(Cells(Target.Row, "B"), Cells(Target.Row, "Q")).Interior.ColorIndex = 39
    Range(Cells(3, Target.Column), Cells(22, Target.Column)).Interior.ColorIndex = 39
End Sub

功能：

选中单元格时，会自动表示对应的行和列。

3、让文件每个一分钟自动保存一次

新增模块并写入如下程序 

Sub otime()
    '一分钟后自动运行WbSave过程
    Application.OnTime Now() + TimeValue("00:01:00"), "WbSave"
End Sub
Sub WbSave()
    ThisWorkbook.Save '保存本工作簿
    Call otime  '再次运行otime过程
End Sub

为了在打开工作簿时就运行如上程序，需要增加Workbook事件（在ThisWorkbook中）

Private Sub Workbook_Open()
    Call otime '打开工作簿后自动运行otime过程
End Sub

 

六、Interior.ColorIndex说明

使用.Range("").Interior.ColorIndex的方法获取对应单元格的ColorIndex值，参照下表。

'用代码就可以获取颜色列表了
Sub 颜色代码()
    For i = 1 To 56
    Cells(i, 1) = i
    Cells(i, 1).Interior.ColorIndex = i
    Next
End Sub