Excel-VBA提高(2): 执行程序的自动开关--对象的事件

之前学习的VBA 代码都写在模块中, 下面学习在对象中的thisworkbook 里写代码是用来干啥的..

(一). workbook对象的事件

在VBE 中双击 thisworkbook

下拉菜单中选择 workbook ,自动生成2行代码, 如上图. Workbook_Open 顾名思义, 在这两行之间插入的代码将会在excel 打开这个工作表时自动运行

Private Sub Workbook_Open()
    MsgBox "现在的时间是" & Time()
End Sub

此时关闭excel 重新打开, 会自动弹出对话框

workbook_open 中, workbook 表示对象名称, open 表示事件名称

在下拉菜单中还有很多关于 workbook这个对象的事件

beforeclose: 关闭工作簿之前

sheetchange: 更改工作表中的单元格时

(二) worksheet对象的事件

1.activate

进入 1班这个工作表的代码窗口, 选择以下:

Private Sub Worksheet_Activate()
    Range("D1").Value = Time    ' 可以不加括号,也可以是 time()
End Sub

则每次进入 1班 sheet, 自动出现

它只对 1班这个sheet 有效果

2.change

Private Sub Worksheet_Change(ByVal Target As Range)
    MsgBox Target.Address & "单元格的值被改为:" & Target.Value
End Sub

在 1班工作表中的任意改动都会出现对话框!

Target.Address 表示被修改单元格的地址; Target.Value 表示修改后的值

如何只让部分单元格被修改时才有提醒?

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then ' 列号是1
    MsgBox Target.Address & "单元格的值被改为:" & Target.Value
End If
End Sub

3. 禁用事件

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False '禁用事件
    Target.Offset(0, 1).Value = "change"
    Application.EnableEvents = True ' 重启禁用
End Sub

一旦修改了某个单元格, 它的左边就自动写change

上述代码要是没有禁用的命令

Private Sub Worksheet_Change(ByVal Target As Range)
    Target.Offset(0, 1).Value = "hello"
End Sub

那么一旦修改了某个单元格, 它左边自动写hello, 自动写的hello 这又是一次修改, 一整行都会写上 hello, 这不是我们想要的结果

例: 快速录入数据

小明开了家文具店 , 每天需要填写销售情况

如何能够简化输入, 通过输入商品的首字母来减少输入量? 假设参照表与记录表在同一个sheet中

MATCH(lookup_value, lookup_array, match_type)

match_type：表示查询的指定方式，用数字-1、0或者1表示

为0时，查找等于lookup_value的第一个数值，lookup_array按任意顺序排列

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub ' 同时更改多个单元格时结束程序
    ' 修改的单元格不是B列2行以下, 则退出
    If Application.Intersect(Target, Range("B2:B1048576")) Is Nothing Then Exit Sub
    If Target.Value = "" Then Exit Sub
    Dim i As Integer
    On Error GoTo a ' match 函数出现错误就去 a
    ' 用match函数确定输入的商品名称是参照表的第几行
    i = Application.WorksheetFunction.Match(UCase(Target.Value), Range("H:H"), False)
    Application.EnableEvents = False ' 防止其他修改时再次执行程序
    With Target
        .Value = Cells(i, "I").Value ' 自动输入商品名称
        .Offset(0, -1).Value = Now '今天日期时间
        .Offset(0, 1).Value = Cells(i, "J").Value ' 商品代码
        .Offset(0, 2).Value = Cells(i, "K").Value ' 商品单价
    End With
    Application.EnableEvents = True ' 重启
    Exit Sub
a: MsgBox "没有与输入内容相匹配的商品!"
    Target.Value = ""
    
End Sub

4. selectionchange 当工作表中选中的单元格改变, 会自动执行

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    MsgBox "你现在选择的单元格是: " & Target.Address
End Sub

这个功能有啥用?? 想不出来... 超级有用的啊...

例 : 想知道某个老师的监考场次

监考表如下, 选中某个名字, 所有该名字所在单元格高亮显示.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Range("B2:K11").Interior.ColorIndex = xlNone '清除底纹颜色
    If Application.Intersect(Target, Range("B2:K11")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Set Target = Target.Cells(1) '选中多个则以第一个为准
    Dim r As Range
    For Each r In Range("B2:K11") ' 遍历每个单元格
        If r.Value = Target.Value Then r.Interior.ColorIndex = 6
    Next r

End Sub

换一个老师的名字, 则会重新运行,清除底纹重新运行

例: 记录每次修改的单元格信息, 记录在该单元格的批注中 , 修改时间+原文+修改文

Dim old As String  ' 定义一个模块级变量

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Formula = "" Then
        old = ""
    Else
        old = Target.Text
    End If
    
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    Dim xin As String
    
    If Target.Formula = "" Then
        xin = ""
    Else
        xin = Target.Text  ' 可以是 target.formula
    End If
    If xin = old Then Exit Sub '修改后不变则退出  无需记录
    
    Dim com As Comment  ' 定义一个批注类型的变量
    Dim com_ As String  ' 记录批注的内容
    Set com = Target.Comment '将被修改的单元格的批注赋给变量 com
    If com Is Nothing Then Target.AddComment   ' 原来没有批注则新建一个
    com_ = Target.Comment.Text ' 将原来的批注保存
    Target.Comment.Text Text:=com_ & Chr(10) & _
    Format(Now(), "yyyy-mm-dd hh:mm") & _
    " 原内容: " & old & _
    " 改为: " & xin
    Target.Comment.Shape.TextFrame.AutoSize = True   ' 根据批注大小自动调整批注大小
   
End Sub

其他worksheet 的事件介绍:

activate : 激活工作表时发生的

beforedelete : 删除之前

beforedoubleclick : 双击之前

beforerightclick

calculate: 重新计算工作表之后

deactivate: 激活状态转变时

followhyperlink: 单击工作表中任意一个超链接时

selectionchange: 选定内容发生改变后

pivottableupdate: 更新数据透视表之后

(三) 不是事件的事件

除了对象的事件,application 还有两种方法, 他们不是对象的事件, 却拥有和事件一样的功能, 实现程序的自动运行

1.application 对象的onkey方法

这个在模块中写就行了!

Sub oktest()
    Application.OnKey "+e", "hello" ' +e表示 shift+e ,按下后运行hello过程
End Sub

Sub hello()
    MsgBox "I'm scarlett"
End Sub

当按下 Shift +e 时 ,自动出现

注: shift --> + , ctrl-->^ , Alt-->%

"^{F1}" 表示 ctrl+F1 组合键

onkey 相当于给过程设置一个执行的快捷键!!! 并且这个快捷键在 所有打开的工作簿都是有效的

2. ontime 指定的时间自动执行的过程

Sub ottest()
    Application.OnTime TimeValue("12:00:00"), "tellme" 'tellme 是要执行的过程名字
End Sub

Sub tellme()
    Beep  '发出一个提示声音
    MsgBox "吃饭了"
End Sub

12:00 到了之后会提示

如果想在10分钟之后有提示怎么做?

Sub ottest()
    Application.OnTime Now() + TimeValue("00:10:00"), "tellme" 'tellme 是要执行的过程名字
End Sub

如果在一个工作簿中通过ontime方法设置好程序运行的时刻, 那么不会因为关闭工作簿而失效,

在不删除代码的条件下, 如何撤销?

Sub ottest()
    Application.OnTime Now() + TimeValue("00:10:00"), "tellme" ' 设置
    Application.OnTime Now() + TimeValue("00:10:00"), "tellme", , False  '撤销
End Sub

例 . 让文件每隔5分钟保存一次

Sub ottest()
    Application.OnTime Now() + TimeValue("00:05:00"), "savewb"
End Sub

Sub savewb()
    ThisWorkbook.Save
    Call ottest   '再次运行 ,下一个5分钟后又会自动保存
End Sub

为了手动设置 ottest , 在thisworkbook 模块中的open 里面写

Private Sub Workbook_Open()
    Call ottest
End Sub

例. 设计一个电子时钟, 每隔1s 更新一次

Private Sub Workbook_Open()
    Call ottest
End Sub

Sub ottest()
    Application.OnTime Now() + TimeValue("00:00:01"), "nowtime"
End Sub

Sub nowtime()
    Range("A13") = Format(Now(), "yyyy-mm-dd hh:mm:ss")
    Call ottest
End Sub

一开打excel 就有了电子时钟了

Excel-VBA提高(2): 执行程序的自动开关--对象的事件

猜你喜欢