VBA常用技巧代码解析

JCQ1235

学习了，谢谢——版主。

wengpicc

收藏中。。。。。。。。

hbcbob

Many thanks

chenking

谢谢

yuanzhuping

本部分收集了没有分类及前面遗漏的一部分技巧。
技巧181         取得电脑名称
       如果希望使用VBA开发的程序只能在某一特定的电脑中使用，那么可以在程序开始时检查当前电脑的名称是否是指定的名称，如下面的代码所示。

1. #001  Private Sub Workbook_Open()
   
2. #002      Dim myName As String
   
3. #003      myName = Environ("Computername")
   
4. #004      If myName <> "ERPSERVER" Then
   
5. #005          MsgBox "对不起您不是合法用户，文件将关闭!"
   
6. #006          ThisWorkbook.Close
   
7. #007      End If
   
8. #008  End Sub

复制代码

代码解析：
       工作簿的Open事件过程，在工作簿打开时判断电脑的名称，如果不是“ERPSERVER”则退出关闭工作簿。
       第3行代码取得电脑的名称。Environ函数返回String，关连一个操作系统环境变量，语法如下：
       Environ({envstring | number})
       参数envstring是可选的，包含一个环境变量名的字符串表达式。如果在环境字符串表格中找到参数envstring，则Environ函数返回在环境字符串表格中对应那个环境变量的等号后面的那段文本。
       Environ("Computername")返回电脑名称，如果需要取得当前登录用户的用户名则使用Environ("UserName")。
       参数number是可选的，用来表示环境字符串在环境字符串表格中的数值顺序。number 参数可以是任意的数值表达式，不过在计算前，它会先转换为一个整数。
       第4行到第7行代码，如果当前电脑不是指定的电脑，关闭工作簿。在实际应用中需要配合其他方法使用户在打开时强制启用宏才能达到这一效果。

philippe86

谢谢

yuanzhuping

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

1. #001  Sub DriveID()
   
2. #002      Dim DriveID
   
3. #003      Set DriveID = CreateObject("Scripting.FileSystemObject")
   
4. #004      MsgBox "C盘的序列号是：" & DriveID.GetDrive("C").SerialNumber, 64
   
5. #005  End Sub

复制代码

代码解析：
       DriveID过程使用GetDrive方法取得电脑C盘的序列号。
       应用于FileSystemObject对象的GetDrive方法返回一个与指定路径中的驱动器相对应的Drive对象，语法如下：
       object.GetDrive drivespec
       object参数是必需的， FileSystemObject对象的名字。关于FileSystemObject对象的引用请参阅技巧180 。
       Drivespec参数是必需的，可以是一个驱动器字符（c）、一个驱动器字符加一个冒号（c:）、一个驱动器字符加冒号和路径分隔符（c:\）或任何网络共享的说明（\\computer2\share1）。
       在使用GetDrive方法返回一个Drive对象后，就可以使用其SerialNumber属性返回C盘的序列号。Drive对象对特定磁盘驱动器或网络共享的属性提供访问，而应用于Drive对象的SerialNumber属性用于唯一标识磁盘卷标的十进制序列号，语法如下：
       object.SerialNumber
       运行DriveID过程将使用消息框显示电脑C盘的序列号，如图所示。
      

yuanzhuping

技巧183         使用API取得硬盘信息
       在VBA中可以使用API函数取得逻辑盘序列号和唯一的物理系列号，如下面的代码所示。

1. #001  Private Const MAX_IDE_DRIVES As Long = 4
   
2. #002  Private Const READ_ATTRIBUTE_BUFFER_SIZE As Long = 512
   
3. #003  Private Const IDENTIFY_BUFFER_SIZE As Long = 512
   
4. #004  Private Const READ_THRESHOLD_BUFFER_SIZE As Long = 512
   
5. #005  Private Const DFP_GET_VERSION As Long = &H74080
   
6. #006  Private Const DFP_SEND_DRIVE_COMMAND As Long = &H7C084
   
7. #007  Private Const DFP_RECEIVE_DRIVE_DATA As Long = &H7C088
   
8. #008  ……代码略，详见附件
   
9. #009  '取得硬盘信息：型号/物理系列号（唯一）
   
10. #010  Function GetHardDiskInfo(Optional ByVal numDisk As eumDiskNo = hdPrimaryMaster, Optional ByVal numType As eumInfoType = hdOnlySN) As String
    
11. #011      If GetDiskInfo(numDisk) = 1 Then
    
12. #012          Dim pSerialNumber As String, pModelNumber As String
    
13. #013          pSerialNumber = StrConv(m_DiskInfo.sSerialNumber, vbUnicode)
    
14. #014          pModelNumber = StrConv(m_DiskInfo.sModelNumber, vbUnicode)
    
15. #015          Select Case numType
    
16. #016              Case hdOnlyModel  '仅型号
    
17. #017                  GetHardDiskInfo = Trim(pModelNumber)
    
18. #018              Case hdOnlySN  '仅系列号
    
19. #019                  GetHardDiskInfo = Trim(pSerialNumber)
    
20. #020              Case Else   '型号,系列号
    
21. #021                  GetHardDiskInfo = Trim(pModelNumber) & "," & Trim(pSerialNumber)
    
22. #022          End Select
    
23. #023       End If
    
24. #024  End Function

复制代码

代码解析;
       使用API函数取得逻辑盘序列号和唯一的硬盘物理系列号，其中GetDiskVolume函数过程取得逻辑盘序列号，GetHardDiskInfo函数过程取得唯一的硬盘物理系列号。
       调用此函数的代码如下。

1. #001  Sub DiskId()
   
2. #002      MsgBox "硬盘的物理系列号：" & GetHardDiskInfo(hdPrimaryMaster, hdOnlySN) _
   
3. #003          & Chr(13) & "C盘的序列号：" & GetDiskVolume("C")
   
4. #004  End Sub

复制代码

运行DiskId过程，使用消息框显示硬盘信息，如图所示。
      

yuanzhuping

技巧184         使用数字签名
       对于Excel中包含VBA的文档，用户最恐惧的一件事情便是是否有病毒，因此往往把Excel安全级别设置为“中”，即对不可靠的来源提醒用户是否启用宏。而对于VBA开发人员来说，最想做的就是使Excel程序启动时不出现警告对话框，直接进入（在安全级别为中的情况下），这时就可以使用数字签名。
       数字签名仅在安装了Microsoft Internet Explorer 4.0 或其后续版本的计算机上有效，并且在安装Excel时，需要选择数字签名一项。
       从“开始”→“程序”→“Microsoft Office” →“Microsoft Office工具” →“VBA项目的数字证书”，在打开的窗口中输入的名称，这时已经完成数字证书的制作，如图所示。

       在Office的安装目录下双击文件“Selfcert.exe”，也可以制作数字证书。
       当程序开发完成后，在VBE窗口中选择“工具”→“数字签名”，在如图所示的对话框中选择“选择”按钮。

       在显示的如图所示的对话框中选择新建的数字证书后按“确定”按钮后保存文件。

       第一次打开含有数字签名的文件时，会显示如图所示的“安全警告”对话框。此时只需要选择“总是相信来自此发布者的宏”选项，这样只要是用此证书签名的文档都会被认为是可靠来源，以后不会再出现“安全警告”对话框。

       如果在打开别人签名的文件时“总是相信来自此发布者的宏”选项为灰，只需选择“详细信息”，在显示的“数字签名详细信息”对话框的“常规”选项中选择“查看证书”，如图 184 5所示。

       然后在显示的“证书”对话框中选择“安装证书”即可，如图所示。

       如果需要删除数字证书，可以打开IE属性对话框，在“内容”选项中选择“证书”，在显示的“证书”对话框中选择证书后删除，如图所示。

       如果有些数字证书在IE属性对话框看不到，可以点击Windows的开始菜单，点击“运行”，键入“Regedit”，回车便打开了注册表编辑器。在“HKEY_CURRENT_USER\Software\Microsoft\SystemCertificates\”位置选择相应的选项删除即可，如图所示。

zzul

谢谢你的劳动