学习笔记 解决方案

11.其他应用——《VBA常用技巧代码解析》

1.取得电脑名称

如果希望使用VBA开发的程序只能在某一特定的电脑使用,那么可以在程序开始时检查当前电脑的名称是否是指定的名称

可以通过Environ函数来获取电脑名称,具体来说,我们可以使用 Environ(“COMPUTERNAME”) 来获取当前电脑的名称。

Option Explicit

' 主程序
Sub 主程序()
    ' 定义允许运行程序的电脑名称
    Const 允许的电脑名称 As String = "DESKTOP-ABCDEF"
    
    ' 获取当前电脑名称
    Dim 当前电脑名称 As String
    当前电脑名称 = 获取电脑名称()
    
    ' 检查电脑名称
    If 当前电脑名称 = 允许的电脑名称 Then
        MsgBox "欢迎使用本程序!", vbInformation
        ' 在这里添加您的主程序代码
        执行主要功能
    Else
        MsgBox "对不起,您无权在此电脑上运行本程序。" & vbNewLine & _
               "当前电脑名称: " & 当前电脑名称, vbExclamation
    End If
End Sub

' 获取电脑名称的函数
Function 获取电脑名称() As String
    获取电脑名称 = Environ("COMPUTERNAME")
End Function

' 主要功能子程序
Sub 执行主要功能()
    ' 这里放置您的主要程序逻辑
    MsgBox "正在执行主要功能...", vbInformation
    ' 添加更多代码...
End Sub

2.取得逻辑盘序列号

使用Environ函数返回电脑的名称,使程序只能在某一特定的电脑中使用,但电脑名称并不是唯一的,有可能多台电脑使用同一名称,所以更好的方法是程序开始时检查电脑的逻辑盘序列号是否是指定的序列号。

Sub DriveID()
    Dim DriveID
    Set DriveID = CreateObject("Scripting.FileSystemObject")
    MsgBox "C盘序列号是" & DriveID.GetDrive("C").SerialNumber, 64
End Sub

3.暂停代码的运行

在程序运行过程中,如果需要暂时停止宏代码的执行,可以使用Application.Wait方法(仅适用于ExcelVBA)

Sub 使用Wait方法()
    MsgBox "程序开始"
    Application.Wait (Now + TimeValue("00:00:05"))
    MsgBox "5秒后"
End Sub

对于所有Office应用程序,我们可以使用Windows API的Sleep函数:

这个方法的有点是在所有VBA环境中都可以使用,而且不会冻结整个应用程序

#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub 使用Sleep函数()
    MsgBox "程序开始"
    Sleep 5000 ' 暂停5秒
    MsgBox "5秒后"
End Sub

4.定时关机

Sub 简单定时关机()
    ' 声明变量
    Dim 延迟分钟 As Long
    Dim 命令 As String
    
    ' 获取用户输入的延迟时间(分钟)
    延迟分钟 = CLng(InputBox("请输入多少分钟后关机:", "定时关机", "60"))
    
    ' 确认关机
    If MsgBox("确定要在 " & 延迟分钟 & " 分钟后关机吗?", vbYesNo + vbQuestion) = vbNo Then
        Exit Sub
    End If
    
    ' 构造关机命令
    命令 = "shutdown /s /t " & (延迟分钟 * 60)
    
    ' 执行命令
    Shell 命令, vbHide
    
    ' 显示确认信息
    MsgBox "系统将在 " & 延迟分钟 & " 分钟后关机。" & vbNewLine & _
           "如果要取消,请在命令提示符中输入: shutdown /a", vbInformation
End Sub

5.打开指定的网页

Sub 打开网页_使用Shell()
    ' 声明变量
    Dim 网址 As String
    
    ' 设置要打开的网址
    网址 = "https://www.example.com"
    
    ' 使用Shell命令打开网页
    Shell "cmd /c start " & 网址, vbHide
End Sub

6.保护VBA代码

VBA项目的源代码是完全开放的,如果不希望其他人看到源代码,可以设置工程密码或者设置“工程不可查看”

设置工程密码

设置VBA工程的密码,只有在输入正确密码后才能看到源代码

通过【菜单栏-工具-VBAProject属性-保护】可以设置密码,保存并关闭文件后,再次打开就需要密码才能查看VBA代码了。

设置“工程不可查看”

使用“保护并共享工作簿”功能将工程设置为不可查看

7.优化代码

关闭屏幕刷新

在使用代码改变工作表的显示内容或格式时关闭屏幕刷新可以加快运行速度

关闭屏幕刷新的主要方法是使用 Application.ScreenUpdating 属性

使用工作表函数

在VBA中使用工作表函数比仅仅使用VBA代码的运行时间要快得多

使用更快的单元格操作方法

在对单元格区域进行操作时,使用Find、Replace、SpecialCells等方法可以比使用VBA代码获得更快的速度

Find方法可以快速在大范围内查找特定值或符合特定条件的单元格

Sub 使用Find方法()
    Dim 查找范围 As Range
    Dim 找到的单元格 As Range
    Dim 开始时间 As Double, 结束时间 As Double
    
    ' 设置查找范围
    Set 查找范围 = Sheet1.Range("A1:Z10000")
    
    开始时间 = Timer
    
    ' 查找值为 "目标" 的单元格
    Set 找到的单元格 = 查找范围.Find(What:="目标", LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not 找到的单元格 Is Nothing Then
        MsgBox "找到目标值在单元格: " & 找到的单元格.Address
    Else
        MsgBox "未找到目标值"
    End If
    
    结束时间 = Timer
    Debug.Print "查找耗时: " & Format(结束时间 - 开始时间, "0.0000") & " 秒"
End Sub

Replace方法可以快速替换大范围内的值,比循环遍历每个单元格要快得多

Sub 使用Replace方法()
    Dim 替换范围 As Range
    Dim 开始时间 As Double, 结束时间 As Double
    
    ' 设置替换范围
    Set 替换范围 = Sheet1.Range("A1:Z10000")
    
    开始时间 = Timer
    
    ' 将所有 "旧值" 替换为 "新值"
    替换范围.Replace What:="旧值", Replacement:="新值", LookAt:=xlWhole
    
    结束时间 = Timer
    Debug.Print "替换耗时: " & Format(结束时间 - 开始时间, "0.0000") & " 秒"
End Sub

SpecialCells方法可以快速选择符合特定条件的单元格,比如空白单元格、包含公式的单元格等

Sub 使用SpecialCells方法()
    Dim 操作范围 As Range
    Dim 空白单元格 As Range
    Dim 开始时间 As Double, 结束时间 As Double
    
    ' 设置操作范围
    Set 操作范围 = Sheet1.Range("A1:Z10000")
    
    开始时间 = Timer
    
    ' 选择所有空白单元格
    On Error Resume Next  ' 防止没有空白单元格时出错
    Set 空白单元格 = 操作范围.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    
    If Not 空白单元格 Is Nothing Then
        ' 对空白单元格进行操作,例如填充默认值
        空白单元格.Value = "默认值"
        MsgBox "已填充 " & 空白单元格.Count & " 个空白单元格"
    Else
        MsgBox "没有找到空白单元格"
    End If
    
    结束时间 = Timer
    Debug.Print "操作耗时: " & Format(结束时间 - 开始时间, "0.0000") & " 秒"
End Sub
使用With语句引用对象

在需要重复引用同一个对象时可以使用With语句来获得较快的运行速度,还可以让代码更加简洁易读

With 对象
    .属性1 = 值1
    .属性2 = 值2
    .方法1 参数
End With

8.取得文件的基本名称

有时在操作时只需要文件的基本名称,此时可以使用GetBaseName方法、

首先,要使用 FileSystemObject,我们需要在 VBA 编辑器中添加对 Microsoft Scripting Runtime 的引用。步骤如下:

在 VBA 编辑器中,点击”工具” > “引用”

在列表中找到并勾选 “Microsoft Scripting Runtime”

点击”确定”

示例:

Sub 获取文件基本名称()
    Dim fso As FileSystemObject
    Dim 文件路径 As String
    Dim 基本名称 As String
    
    ' 创建 FileSystemObject 实例
    Set fso = New FileSystemObject
    
    ' 示例文件路径
    文件路径 = "C:\Users\Documents\报告2023.xlsx"
    
    ' 获取文件的基本名称
    基本名称 = fso.GetBaseName(文件路径)
    
    ' 显示结果
    MsgBox "文件的基本名称是: " & 基本名称
    
    ' 清理对象
    Set fso = Nothing
End Sub

9.防止用户中断代码运行

在使用VBA开发的程序交予用户使用后,如果在运行需要长时间执行的宏代码时,用户在代码运行期间按下了ESC键获CTRL+BREAK键,会显示“代码执行被中断”

此时单击“继续”按钮会继续执行代码,单击“结束”按钮解释过程,单击“调试”按钮进入中断模式,这显然不是用户所希望出现的,可以使用Application对象的EnableCancelKey属性来进行控制。

Application.EnableCancelKey 属性有三个可能的值:

xlDisabled (值为 0): 完全禁用中断功能。

xlInterrupt (值为 1): 允许中断,但不进入调试模式(默认值)。

xlErrorHandler (值为 2): 允许中断,但触发错误处理程序。

使用 EnableCancelKey 的注意事项:

记得恢复原始设置:在代码结束时,务必将 EnableCancelKey 恢复到原始状态,以免影响其他宏的正常运行。

错误处理:当使用 xlErrorHandler 时,确保有适当的错误处理机制来捕获和处理用户中断。

用户体验:虽然禁用中断可以防止用户意外停止宏,但也可能让用户感到失去控制。考虑添加进度指示器或允许用户通过其他方式(如点击按钮)来安全地停止操作。

长时间运行的代码:对于真正长时间运行的代码,考虑使用 DoEvents 函数来允许 Excel 响应其他事件,保持应用程序的响应性。

测试:在不同情况下充分测试您的代码,确保它能正确处理各种情况,包括正常完成、用户中断和其他可能的错误。

完全禁用中断功能:

Sub 禁用中断功能()
    ' 保存原始设置
    Dim 原始设置 As Long
    原始设置 = Application.EnableCancelKey
    
    ' 设置为禁用中断
    Application.EnableCancelKey = xlDisabled
    
    ' 执行长时间运行的代码
    Call 长时间运行的过程()
    
    ' 恢复原始设置
    Application.EnableCancelKey = 原始设置
    
    MsgBox "操作已完成!"
End Sub

Sub 长时间运行的过程()
    ' 模拟长时间运行的过程
    Dim i As Long
    For i = 1 To 1000000
        ' 执行一些操作
        DoEvents ' 允许 Excel 响应其他事件
    Next i
End Sub

使用错误处理程序:

Sub 使用错误处理程序()
    ' 保存原始设置
    Dim 原始设置 As Long
    原始设置 = Application.EnableCancelKey
    
    ' 设置为触发错误处理程序
    Application.EnableCancelKey = xlErrorHandler
    
    On Error GoTo 错误处理
    
    ' 执行长时间运行的代码
    Call 长时间运行的过程()
    
    ' 正常完成
    MsgBox "操作已成功完成!"
    
结束:
    ' 恢复原始设置
    Application.EnableCancelKey = 原始设置
    Exit Sub
    
错误处理:
    ' 处理用户中断
    If Err.Number = 18 Then ' 18 是用户中断的错误代码
        MsgBox "操作被用户中断。", vbExclamation
    Else
        MsgBox "发生错误: " & Err.Description, vbCritical
    End If
    Resume 结束
End Sub

结合进度条使用:

Sub 带进度条的长时间过程()
    ' 保存原始设置
    Dim 原始设置 As Long
    原始设置 = Application.EnableCancelKey
    
    ' 设置为禁用中断
    Application.EnableCancelKey = xlDisabled
    
    ' 创建进度条
    Dim 进度条 As Object
    Set 进度条 = CreateObject("Excel.Application")
    进度条.Visible = False
    进度条.DisplayStatusBar = True
    
    ' 执行长时间运行的代码
    Dim i As Long
    For i = 1 To 100
        ' 更新进度条
        进度条.StatusBar = "处理中... " & i & "% 完成"
        
        ' 模拟一些工作
        Application.Wait Now + TimeValue("00:00:01")
    Next i
    
    ' 清理进度条
    进度条.StatusBar = False
    进度条.Quit
    Set 进度条 = Nothing
    
    ' 恢复原始设置
    Application.EnableCancelKey = 原始设置
    
    MsgBox "操作已完成!"
End Sub

使用 EnableCancelKey 的注意事项:

记得恢复原始设置:在代码结束时,务必将 EnableCancelKey 恢复到原始状态,以免影响其他宏的正常运行。

错误处理:当使用 xlErrorHandler 时,确保有适当的错误处理机制来捕获和处理用户中断。

用户体验:虽然禁用中断可以防止用户意外停止宏,但也可能让用户感到失去控制。考虑添加进度指示器或允许用户通过其他方式(如点击按钮)来安全地停止操作。

长时间运行的代码:对于真正长时间运行的代码,考虑使用 DoEvents 函数来允许 Excel 响应其他事件,保持应用程序的响应性。

测试:在不同情况下充分测试您的代码,确保它能正确处理各种情况,包括正常完成、用户中断和其他可能的错误。

1 thought on “11.其他应用——《VBA常用技巧代码解析》”

发表回复