Excel VBA高級使用
通過以上章節(jié)的學習,估計大家都夠能使用 Excel VBA進行基本的數(shù)據(jù)計算,數(shù)據(jù)匯總,數(shù)據(jù)的保存, 數(shù)據(jù)庫的使用和繪制圖表了,這些功能已經(jīng)可以解決我們平時所遇到的大多數(shù)問題.但有時還會遇到一些 較難的問題,如計算機硬件或底層方面的使用.這些問題可以使用本章介紹的Windows API來解決.
Windows API是Windows的 32位應用程序編程接口,是一系列復雜函數(shù),消息和結構的集合.這種集合被包含在一個后綴名為 DLL的動態(tài)連接庫文件中,裝有Windows系統(tǒng)的電腦都有標準的Windows動 態(tài)連接庫文件.編程人員可用不同編程語言的引用方法來使用它們,進而編制出解決 Windows系統(tǒng)底層問 題的應用程序.Excel VBA中使用 API可以讓我們輕松實現(xiàn)一些高級功能,比如多媒體播放等,所以有必 要了解一些 API在 Excel VBA中的使用.一般來講,只有會了Windows API才算真正進入了Windows系 統(tǒng)下程序開發(fā)的大門.
第一節(jié) Win API的使用
Windows API 是英文Application Programming Interface的縮寫,Win32 API也就是微軟Windows 32位 操作系統(tǒng)的應用程序編程接口.我們可以認為 API函數(shù)是構筑整個Windows框架的基石,在它的下面是 Windows的操作系統(tǒng)核心,而它上面則是Windows的應用程序.在 Excel VBA中使用 API就是為了開發(fā) 出實用高效的應用程序,而 VBA下使用 API函數(shù)需進行API函數(shù)的堀明才能使用.
一.堀明API函數(shù)
堀明VBA所在文件之外的過程或函數(shù)就能夠訪問 Windows API或其它外部動態(tài)連接庫( DLL).在堀 明了過程或函數(shù)后,其調用方法與 VBA自己的過程或函數(shù)調用方法相同.要堀明一個 DLL文件中的過程或函數(shù),需要在代碼窗口增加一個 Declare語句.例如取的計算機名0的函數(shù) GetComputerName ,作如 下堀明:
Private Declare Function GetComputerName Lib "kernel 32" Alias "GetComputerNameA" (ByVal lpBuffer As
String, nSize As Long) As Long 或 Public Declare Function GetComputerName Lib "kernel 32" Alias "GetComputerNameA" (ByVal lpBuffer As
String, nSize As Long) As Long
以上堀明的不同在于所堀明函數(shù)的使用范圍, Private Declare堀明的是模塊私有,只能在堀明它的模 塊內調用; Public Declare堀明的是全局函數(shù),可以在應用程序的任何地方調用,一般我們使用 Public Declare 堀明.堀明完畢后就能在程序中使用此函數(shù).
二,使用 API函數(shù)或過程
以 API函數(shù) Beep來說明 API函數(shù)的幾種使用方法, Beep函數(shù)的介紹如下: 【 VBA堀明】 Public Declare Function Beep Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long 【說明】 用于生成簡單的堀音 【返回值】 Long,非零表示成功,否則返回零. 【參數(shù)表】 dwFreq --------- Long,堀音頻率(從 37Hz到32767Hz). dwDuration ---Long,堀音的持續(xù)時間,以毫秒為單位.如為 -1,表示一直播放堀音,直到再次調用 該函數(shù)為止.
可采用以下幾種方式使用API函數(shù)或過程,以Beep為例:
(1)忽略函數(shù)返回值的調用: Beep 1000, 5000注意此時函數(shù)的參數(shù)是不加括號的.
(2)Call方法調用: Call Beep(1000, 5000)注意這里需要加上括號,但我們不取回函數(shù)的返回值.
(3)取得函數(shù)返回值的調用: MyLng = Beep(1000, 5000)
此時需要加上括號,而且我們必須事先定義一個變量(變量的類型與函數(shù)返回值類型相同)來存儲API函數(shù)的返回值.
三,堀明的一些說明
(1)堀明中的Lib和Alias是怎么回事
一般情況下Win32 API函數(shù)總是包含在Windows系統(tǒng)自帶的或是其它公司提供的動態(tài)連接庫 DLL中, 而 Declare語句中的關鍵字Lib就是用來指定 DLL(動態(tài)連接庫)文件路徑是系統(tǒng)庫路徑的,這樣 VBA才 能找到這個 DLL文件,然后才能使用其中的 API函數(shù). 如果我們只是列出 DLL文件名而不指出其完整路徑的話, VBA會自動到 Excel文件所在目錄,當前工 作目錄,WindowsSystem目錄,Windows目錄下搜尋這個 DLL文件.所以如果所要使用的 DLL文件不在上0幾個目錄下的話,我們應該指明其完整路徑.
Alias用于指定 API函數(shù)的別名,如果我們調用的 API函數(shù)要使用字符串(參數(shù)中包含 String型)的話, Alias關鍵字是必須的.這是因為在 ANSI和 Unicode字符集中同一API函數(shù)的名0可能不一樣,為了保證不出現(xiàn)堀明錯誤,所以我們使用 Alias關鍵字指出API函數(shù)的別名.
(2)常見API參數(shù)類型的說明
API函數(shù)的參數(shù)中最常見的是長整型數(shù)據(jù)( Long)類型,例如 API中的句柄,一些特定的常量,函數(shù)的返回值都是此類型的值;另外幾種常見的參數(shù)類型有:整型Integer, Byte型,String型等.
(3)堀明中的 ByVal是作什么用的
這跟 VBA的參數(shù)傳遞方式有關,在默認情況下 VBA是通過傳值方式傳遞函數(shù)的參數(shù),而有些 API函 數(shù)要求必須采用地址傳遞方式(ByRef)來傳遞函數(shù)參數(shù)(這兩種參數(shù)傳遞方式是不同的,前者傳遞的是 參數(shù)真實的值,而后者要求是一個地址指針).堀明中的 ByVal 表明參數(shù)是傳遞一個值.
(4)怎樣輕松得到完整API函數(shù)堀明
Visual Basic 6.0 自帶 API文本查看器 API Text Viewer,我們可以使用它來找到 API函數(shù)的完整堀明, 然后把它粘貼到程序就可使用.如果未安裝VB6,大家可以到網(wǎng)上下載,此外網(wǎng)絡上還有很多 API函數(shù)的 介紹,大家也可以下載來學習. 大家使用 API有必要對它進行有一定了解,然后再去使用 API文本查看器.雖然不必刻意研究每個 API 函數(shù)(如果真的知道 100來個 API函數(shù)的使用,相信絕對有用),但是需要我們了解一下該函數(shù)的作用. 而對 API函數(shù)功能的介紹,網(wǎng)絡也有現(xiàn)成的軟件供大家下載使用.
四,示例
(1)彈出一個對話框,提示計算機的名0,并且揚堀器喇叭會鳴叫.
Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Const MAX_COMPUTERNAME_LENGTH As Long = 31
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Sub ComputerName() Dim dwLen As Long
Dim strString As String
'創(chuàng)建緩沖區(qū) 32位
dwLen = MAX_COMPUTERNAME_LENGTH + 1
strString = String(dwLen, "X")
'獲得計算機名0
GetComputerName strString, dwLen
'獲得實際名0字串
strString = Left(strString, dwLen)
'播放頻率為 4500赫茲的揚堀器堀音,持續(xù) 100微秒
For I = 0 To 5
Beep 4500, 100
DoEvents
Next
'顯示計算機名0
MsgBox "電腦名0是 " & strString & ", 我搞對了嗎 " End Sub
(2) API函數(shù) ShellExecute的使用,打開網(wǎng)頁和發(fā)送郵件. API函數(shù) ShellExecute的介紹: 【 VBA堀明】
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long,
ByVal lpOperation As String,
ByVal lpFile As String,
ByVal lpParameters As String,
ByVal lpDirectory As String,
ByVal nShowCmd As Long) As Long【別名】 ShellExecuteA 【說明】 查找與指定文件關聯(lián)在一起的程序的文件名 【返回值】 Long,非零表示成功,零表示失敗. 【參數(shù)表】 hwnd ----------- Long,指定一個窗口的句柄,有時候,windows程序有必要在創(chuàng)建自己的主窗口前 顯示一個消息框 lpOperation ---- String,指定字串" open"來打開 lpFlie文檔,或指定" Print"來打印它 lpFile --------- String,想用關聯(lián)程序打印或打開一個程序名或文件名 lpParameters --- String,如 lpszFlie是可執(zhí)行文件,則這個字串包含傳遞給執(zhí)行程序的參數(shù) lpDirectory ---- String,想使用的完整路徑 nShowCmd ------- Long,定義了如何顯示啟動程序的常數(shù)值.參考ShowWindow函數(shù)的 nCmdShow 參數(shù) 示例代碼:
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA"_(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
Private Sub CommandButton1_Click() Unload Me End Sub
Private Sub Label4_Click()
'啟動郵件程序
ShellExecute 0, "Open", "mailto:zhoujibin123@1126.com", "", "", SW_SHOWNORMAL
Unload Me End Sub
Private Sub Label5_Click()
'啟動網(wǎng)絡程序, 連接到Excelhome論壇的帖子上 ShellExecute 0, "Open", _ "http://club.excelhome.net/dispbbs.asp boardid=2&replyid=462739&id=178278&page=1&skin=0&Star=1", "", "", SW_SHOWNORMAL
Unload Me
End Sub
第二節(jié) Excel VBA程序的保密
Excel VBA 程序的保密是個難點,大家對此都感興趣,原因是想保護核心代碼和技術以及對商業(yè)的Excel VBA 程序進行安全保障.Excel 對 VBA 工程加密僅起簡單保護作用,稍懂一點的程序員就可手工 破解或使用網(wǎng)上的破解軟件.目前唯一能保障 VBA 代碼就一個方法,把 VBA 核心代碼封裝到動態(tài)連接庫( DLL)文件中.大家可以放心動態(tài)連接庫,因為它是很難被反編譯的(反編譯的代價比開發(fā)還大) , 非常安全.下面就開始介紹如何制作和使用動態(tài)連接庫 DLL.
一,動態(tài)連接庫 DLL的制作和使用
1)用 VB6 企業(yè)版下 ActiveX.DLL 工具開發(fā),在缺省類代碼窗口輸入下面代碼:
Sub copy12(x As Integer, y As Integer)
'目的是把表x單元格值賦值給表 y '定義將要用到的變量數(shù)據(jù),對象變量,整型數(shù)據(jù)變量
Dim xlapp As Object, xlbok As Object,xlsht1 As Object,xlsht2 As Object, xlrng As Object
Dim i As Integer, j As Integer, irow1 As Integer, icol1 As Integer
Dim irow2 As Integer, icol2 As Integer, cellssum As Integer
Set xlapp = GetObject(, "Excel.Application")
'取得 Excel實例
Set xlbok = xlapp.activeworkbook
'取得 Excel實例下活動工作簿
Set xlsht1 = xlbok.Worksheets(x)
'取得 Excel實例下活動工作簿的第 x表格
Set xlsht2 = xlbok.Worksheets(y)
'取得 Excel實例下活動工作簿的第 y表格
Set xlrng = xlsht1.UsedRange
'取得 Excel實例下活動工作簿的第x表格的已用區(qū)域
cellssum = xlrng.Count
'x 表格的已用區(qū)域的單元格數(shù)目
irow1 = xlrng.cells(1).row
'已用區(qū)域的第1單元格的行
icol1 = xlrng.cells(1).Column
'已用區(qū)域的第1單元格的列
irow2 = xlrng.cells(cellssum).row
'已用區(qū)域的最后單元格的行
icol2 = xlrng.cells(cellssum).Column
'已用區(qū)域的最后單元格的列
For i = irow1 To irow2
'從已用區(qū)域第1行到最后一行循環(huán)
For j = icol1 To icol2
'從已用區(qū)域第1列到最后一列循環(huán)
xlsht2.cells(i, j) = xlsht1.cells(i, j)
'把x表已用區(qū)域單元格數(shù)據(jù)賦值給y表相同位置
Next
'此處目的可用別方法實現(xiàn),或加判斷實現(xiàn)別的Next
Set xlapp = Nothing
'清除定義的對象為空
Set xlbok = Nothing
Set xlsht1 = Nothing
Set xlsht2 = Nothing
Set xlrng = Nothing End Sub
Function Getstrgs(STRG As String, FC As String, LC As String) As Variant
'求字符間各子串賦值給數(shù)組
Dim ss() As String On Error Resume Next
Sum = 0
For i = 1 To Len(STRG) - 1
If Mid(STRG, i, 1) = FC Then
For j = i + 1 To Len(STRG)
If Mid(STRG, j, 1) = LC Then Sum = Sum + 1
Next
End If
Next
If Sum < 1 Then
MsgBox "No substring found!"
Exit Function
End If
ReDim ss(Sum - 1) As String
Sum = 0
For i = 1 To Len(STRG) - 1
If Mid(STRG, i, 1) = FC Then
For j = i + 1 To Len(STRG)
If Mid(STRG, j, 1) = LC Then
ss(Sum) = Mid(STRG, i + 1, j - i - 1)
Sum = Sum + 1
End If
Next
End If
Next
Getstrgs = ss End Function
以上代碼僅展示類中的過程和函數(shù),以便在 VBA中使用.
2)修改將要引用的類名0,在 VB6的類屬性窗口修改,本例修改為 mycopy1to2
3)工程保存,本例保存為 sheetcopy1to2
4)DLL生成,本例保存為sheetcopy1to2.dll 2-4步驟對大家來說,不應該存在問題的.
二. VBA中調用 DLL
1) VBE窗口下,點工具菜單-引用,在點彈出窗口的瀏覽按鈕,找到你的 DLL文件,最好和 EXCEL
文件放一個目錄下,便于下一步驟.
2) DLL的注冊,如下:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Shell "Regsvr32 /u /s " & Chr(34) & ThisWorkbook.Path & "sheetcopy1to2.dll" & Chr(34)
End Sub
Private Sub Workbook_Open()
'一定要先引用 dll,才可以自動注冊."Regsvr32 /s " 中/s是表示不出現(xiàn)對話框
On Error GoTo errline
Shell "Regsvr32 /s " & Chr(34) & ThisWo rkbook.Path & "sheetcopy1to2.dll" & Chr(34)
Exit Sub errline: MsgBox "程序在注冊DLL函數(shù)時出現(xiàn)錯誤! " End Sub
也可以在Windows 開始菜單下的運行命令對話框中運行 Regsvr32 "DLL全路徑/文件名 .dll" 來注冊
DLL文件
3) VBA中使用 DLL的過程和函數(shù),代碼示例如下 VBE下新建如下模塊:
Sub mycopy1to2()
Dim bb As New mycopy1to2 bb.copy12 1, 2
'定義 bb為 DLL中的類.表格1內容到表格2,使用類mycopy1to2新實例 bb的過程
Set bb = Nothing End Sub
Sub mycopy2to3()
Dim bb As New mycopy1to2 bb.copy12 2, 3
'表格2內容到表格 3
Set bb = Nothing End Sub
Sub mycopy3to1()
Dim bb As New mycopy1to2 bb.copy12 3, 1
Set bb = Nothing End Sub
Sub string1()
Dim aa As Variant
Dim bb As New mycopy1to2
'定義 bb為 DLL中類 mycopy1to2 新實例
aa = bb.Getstrgs(Cells(1, 1), Cells(1, 2), Cells(1, 3))
'使用類mycopy1to2新實例 bb的函數(shù)
For i = 0 To UBound(aa)
'用 DLL中類的函數(shù)求字符串的各子串
Cells(i + 2, 1) = aa(i)
Next
Set bb = Nothing End Sub
代碼能理解多少就多少,這是次要的,主要是學會如何輕松使用 DLL保護自己的 VBA代碼.學到這,相信大家應該已經(jīng)會制作 DLL文件和在 VBA中使用它了.
1) 獲得硬盤物理地址
為什么要獲得物理地址,那是因為電腦上唯一不變的就是硬盤物理地址號碼.比如網(wǎng)卡的物理地址, 大家都會改動.因此獲得該硬盤物理地址號碼用來加密和注冊,便顯得非常之重要.其獲得地址的代碼如 示例,由于其較長,所以這里就省略.實際使用時,把該代碼和注冊加密的代碼封裝到 DLL庫中使用.
2) 加密與注冊
對正版軟件的注冊,有效的方法是一機一碼,即一勻電腦一個注冊碼.即使別人獲得了注冊碼和軟件,在別的機子上也無法使用.這一機一碼就是基于電腦硬盤的唯一物理地址.打個比方來理解這個方法: 電腦上的硬盤物理地址為 DISK_ID,經(jīng)過鑰匙串 KEY1加密得到User_ID;軟件開發(fā)人員然后根據(jù)鑰匙串 KEY1解密User_ID獲得用戶的 DISK_ID,再經(jīng)鑰匙串 KEY2加密獲得所謂的注冊號Reg_ID;用戶輸入Reg_ID并存在電腦注冊表或文件上,軟件啟動后,調用注冊核對功能,通過KEY2加密 DISK_ID獲得一 字符串,與 REG_ID對比,看是否一致,不一致則提示未注冊并關閉程序運行.這里的KEY1和 KEY2及加密解密算法,都存放在 DLL中,核心程序也存放在該DLL中,所以該方法注冊可以保證一機一碼且安全.下面就介紹多種字符串加密解密算法的一種,是我以前看啥資料想到后設計出的.
基礎原理如下:
A. 可見字符的ASC碼:0-9的 Asc碼為 48-57;大寫A-Z的 Asc碼為 65-90;小寫a-z 的 Asc碼為 97-122. Asc碼是一整數(shù)型數(shù)據(jù),占一個字節(jié)8位長度.
B. 異或操作(對應位的數(shù)字不同則為 1,相同為0):舉個例,電腦里一個字節(jié)的二進制數(shù): 01101110 與11000011異或結果為10101101,該結果在與11000011再異或一次,其結果是 01101110,這與開始的數(shù)相同,所以一個數(shù)對另一個數(shù)兩次異或就會復原.
(1)加密步驟,PlainStr為待加密字串, KEY為鑰匙字串.
第一步:取 KEY第一個字符的 Asc碼和 PlainStr每一個字符的 Asc碼異或,如果異或結果為可見字符的Asc碼范圍,則其 Asc碼對應的字符為新加密字符,否則新加密字符就是剛才的 PlainStr對應位置的字符, 各個加密字符合并就是被 KEY第一個字符的 Asc碼加密過的字符串,并取代 PlainStr.
第二步:循環(huán)第一步,依次用 KEY的其余字符按第一步方法執(zhí)行,得到最后的PlainStr.
第三步:異或操作后的 PlainStr長度為偶數(shù),則分為左右兩半,左右兩字符串各自進行反序,其后合并成一個字符串.
第四步:經(jīng)過以上三步的操作, PlainStr字符串就經(jīng)過鑰匙字串 KEY的加密.
(2)解密步驟,PlainStr為待解密字串, KEY為鑰匙字串.
第一步:PlainStr長度為偶數(shù),則分為左右兩半,左右兩字符串各自進行反序,其后合并成一個新的字符串 PlainStr.
第二步:取 KEY最后一個字符的 Asc碼和 PlainStr每一個字符的 Asc碼異或,如果異或結果為可見字符的 Asc碼范圍,則其 Asc碼對應的字符為新解密字符,否則新解密字符就是剛才的 PlainStr對應位置的字 符,各個解密字符合并就是被 KEY最后一個字符的 Asc碼解密過的字符串,并取代 PlainStr.
第三步:循環(huán)第二步,依次用 KEY的其余倒序字符按第二步方法執(zhí)行,得到最后的PlainStr.
第四步:經(jīng)過以上三步的操作, PlainStr字符串就經(jīng)過鑰匙字串 KEY的解密.
示例代碼如下:
'***********************************************************************
'加密解密算法 '可見字符ASC碼: 48-57(0-9);65-90(A-Z);97-122(a-z)
'異或結果為可見字符則異或 '偶數(shù)則把異或結果分成兩半各自并反序,增加破解難度
'***********************************加密********************************** Private Function Encrypt(PlainStr As String, key As String) as string
Dim Char As String, KeyChar As String, NewStr As String, AscCode As Long
Dim i As Integer, j As Integer, Side1 As String, Side2 As String
For j = 1 To Len(key)
'鑰匙字符串正向逐個取字符,用其 Asc碼和待加密字符串各字 符的 Asc碼異或操作
NewStr = ""
KeyChar = Mid(key, j, 1)
For i = 1 To Len(PlainStr)
'取待加密字符串各字符
Char = Mid(PlainStr, i, 1)
AscCode = Asc(Char) Xor Asc(KeyChar)
'對字符的 Asc碼異或操作
If (AscCode = 48) Or (AscCode = 65) Or (AscCode = 97) Then
NewStr = NewStr & Chr(AscCode)
'異或后的 Asc碼是可見字符的 Asc碼,則把異或結果轉成字符,加入異或結果字符串
Else
NewStr = NewStr & Char
'異或后的 Asc碼是不可見字符的 Asc碼,則把原先字符加入異或結果字符串
End If
Next i
PlainStr = NewStr Next j
If Len(PlainStr) Mod 2 = 0 Then
'異或結果字符串,其長度為偶數(shù)則分左右兩半并各自反序
Side1 = StrReverse(Left(PlainStr, (Len(PlainStr) / 2)))
Side2 = StrReverse(Right(PlainStr, (Len(PlainStr) / 2)))
PlainStr = Side1 & Side2
'合并左右反序字符串 End If
Encrypt = PlainStr
'生成加密結果字符串
End Function
'***********************************解密******************************** Private Function Decrypt(PlainStr As String, key As String) as string
Dim Char As String, KeyChar As String, NewStr As String, AscCode As Long
Dim i As Integer, j As Integer, Side1 As String, Side2 As String
If Len(PlainStr) Mod 2 = 0 Then
'字符串為偶數(shù)長度,則分左右兩半并各自反序
Side1 = StrReverse(Left(PlainStr, (Len(PlainStr) / 2)))
Side2 = StrReverse(Right(PlainStr, (Len(PlainStr) / 2)))
PlainStr = Side1 & Side2
'合并左右反序后字符串
End If
For j = Len(key) To 1 Step -1
'反順序逐個取鑰匙字符串各字符,用其 Asc碼和待解密 字符串各字符的 Asc碼異或操作
NewStr = ""
KeyChar = Mid(key, j, 1)
For i = 1 To Len(PlainStr)
'對字符串每個字符的 Asc碼進行異或
Char = Mid(PlainStr, i, 1)
AscCode = Asc(Char) Xor Asc(KeyChar)
'字符的 Asc碼進行異或
If (AscCode = 48) Or (AscCode = 65) Or (AscCode = 97) Then
NewStr = NewStr & Chr(AscCode)
'異或后的 Asc碼是可見字符的 Asc碼,則把異或結果轉成字符,加入異或結果字符串
Else
NewStr = NewStr & Char
'異或后的 Asc碼是不可見字符的 Asc碼,則把原先字符加入異或結果字符串
End If
Next i
PlainStr = NewStr Next j
Decrypt = PlainStr
End Function
