1、Excel VBA編程的常用代碼用過VB的人都應該知道如何聲明變量，在 VBA中聲明變量和 VB中是完全一樣的!使用Dim語句Dim a as integer '聲明a為整型變量Dim a '聲明a為變體變量Dim a as string '聲明a為字符串變量Dim a as currency ,b as currency ,c as currency ' 聲明 a,b,c 為貨幣變量聲明變量可以是： Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal （當前不 支持）、Date、String （只限

2、變長字符串）、 String * length （定長字符串）、 Object、Variant 用戶 定義類型或對象類型。強制聲明變量Option Explicit說明：該語句必在任何過程之前出現在模塊中。聲明常數 用來代替文字值。Const'常數的默認狀態是Private。Const My = 456'聲明Public常數。Public Const MyString = "HELP"'聲明 Private Integer 常數。Private Const MyInt As Integer = 5'在同一行里聲明多個常數。Const MySt

3、r = "Hello", MyDouble As Double = 3.4567選擇當前單元格所在區域在EXCEL97中，有一個十分好的功能，他就是把鼠標放置在一個有效數據單元格中，執行該段代碼,你就可以將連在一起的一片數據全部選中。只要將該段代碼加入到你的模塊中。返回當前單元格中數據刪除前后空格后的值sub my_trimmsgbox Trim(ActiveCell.Value)end sub單元格位移sub my_offsetActiveCell.Offset(0, 1).Select'當前單元格向左移動一格ActiveCell.Offset(0, -1).Se

4、lect'當前單元格向右移動一格ActiveCell.Offset(1 , 0).Select'當前單元格向下移動一格ActiveCell.Offset(-1 , 0).Select'當前單元格向上移動一格end sub如果上述程序產生錯誤那是因為單元格不能移動，為了解除上述錯誤，我們可以往sub my_offset 之下力段代碼on error resume next注意以下代碼都不再添加sub代碼名稱”和end sub請自己添加！給當前單元格賦值ActiveCell.Value =" 你好！ ！ ！"給指定單元格賦值例如：A 1單元格內容設為&q

5、uot;HELLO "Range("a1").value="hello"又如：你現在的工作簿在sheetl上，你要往sheet2的Al單元格中插入"HELLO1.sheets("sheet2").selectrange("a1").value="hello"或2.Sheets("sheet1").Range("a1").Value = "hello"說明：1.sheet2被選中，然后在將“HELLO賦至U A1單元格

6、中。2.sheet2不必被選中，即可“HELLO賦至U sheet2 的A1單元格中。隱藏工作表'隱藏SHEET1這張工作表sheets("sheet1").Visible=False'顯示SHEET1這張工作表sheets("sheet1").Visible=True打印預覽有時候我們想把所有的EXCEL中的SHEET都打印預覽，請使用該段代碼，它將在你現有的工作簿中循環，直到最后一個工作簿結束循環預覽。Dim my As WorksheetFor Each my In Worksheetsmy.PrintPreviewNext my得

7、到當前單元格的地址msgbox ActiveCell.Address得到當前日期及時間msgbox date & chr(13) & time保護工作簿ActiveSheet.Protect取消保護工作簿ActiveSheet.Unprotect給活動工作表改名為"liu"ActiveSheet.Name = "liu"打開一個應用程序AppActivate (Shell("C:/WINDOWS/CALC.EXE")增加一個工作表Worksheets.Add刪除活動工作表activesheet.delete打開一個工作

8、簿文件Workbooks.Open FileName:="C:/My Documents/Book2.xls"關閉活動窗口ActiveWindow.Close單元格格式選定單元格左對齊Selection.HorizontalAlignment = xlLeft選定單元格居中Selection.HorizontalAlignment = xlCenter選定單元格右對齊Selection.HorizontalAlignment = xlRight選定單元格為百分號風格Selection.Style = "Percent"選定單元格字體為粗體選定單元格字體為

9、斜體選定單元格字體為宋體20號字With Selection.Font.Name ="宋體".Size = 20End WithWith語句With對象.描述End With清除單元格ActiveCell.Clear'刪除所有文字、批注、格式返回選定區域的行數返回選返回選定區域的地址Selection.Address忽略所有的錯誤ON ERROR RESUME NEXT遇錯跳轉on error goto err_handle'中間的其他代碼err_handle:'標簽'跳轉后的代碼刪除一個文件kill "c:/1.txt"

10、定制自己的狀態欄Application.StatusBar ="現在時刻："& Time恢復自己的狀態欄Application.StatusBar = false用代碼執行一個宏Application.Run macro:="text"滾動窗口到a1的位置ActiveWindow.ScrollRow = 1ActiveWindow.ScrollColumn = 1定制系統日期MyDate = #12/12/69#MyDay = Day(MyDate)返回當天的時間Dim MyDate, MyYearMyDate = DateMyYear = Ye

11、ar(MyDate)MsgBox MyYearinputbox< 輸入框 >XX=InputBox ("Enter number of months to add")得到一個文件名Dim kk As StringEXCEL 文kk = Application.GetOpenFilename("EXCEL (*.XLS), *.XLS", Title:=" 提示：請打開 件：”)msgbox kk打開zoom對話框Application.Dialogs(xlDialogZoom).Show激活字體對話框Application.Dial

12、ogs(xlDialogActiveCellFont).Show打開另存對話框Dim kk As String kk = Application.GetSaveAsFilename("excel (*.xls), *.xls")Workbooks.Open kk工作簿(Workbook)基本操作應用示例(一)Workbook對象代表工作簿，而Workbooks集合則包含了當前所有的工作簿。下面 對Workbook對象 的重要的方法和屬性以及其它一些可能涉及到的方法和屬性 進行示例介紹，同時，后面的示例也深入介紹了一些工作簿對象操作的方法和技巧。示例03-01 :創建工彳乍簿

13、(Add方法)示例 03-01-01Sub CreateNewWorkbook1()MsgBox "將創建一個新工作簿."Workbooks.AddEnd Sub示例 03-01-02Sub CreateNewWorkbook2()Dim wb As WorkbookDim ws As WorksheetDim i As LongMsgBox "將創建一個新工作簿，并預設工作表格式."Set wb = Workbooks.AddSet ws = wb.Sheets(1)ws.Name ="產品匯總表"ws.Cells(1, 1)=&q

14、uot;序號"ws.Cells(1,2)=" 產品名稱"ws.Cells(1,3)="產品數量"For i = 2 To 10ws.Cells(i, 1) = i - 1Next iEnd Sub示例03-02 :添加并保存新工作簿Sub AddSaveAsNewWorkbook()Dim Wk As WorkbookSet Wk = Workbooks.AddApplication.DisplayAlerts = FalseWk.SaveAs Filename:="D:/SalesData.xls"End Sub 示例說明

15、：本示例使用了 Add方法和SaveAs方法，添加一個新工作簿并將 該工作簿以文件名 SalesData.xls 保存在 D盤中。其中，語句Application.DisplayAlerts = False 表示禁止 彈出警告對話 框。示例03-03 :加工作簿(Open方法)示例 03-03-01Sub openWorkbook1()Workbooks.Open " 需打 開文件的路徑/文件名"End Sub示例說明：代碼中的 里的內容需用所需打 開的文件的路徑及文件名代替。Open方法共有15個參數,其中參數FileName為必需的參數，其余參數可選。示例 03-03-

16、02Sub openWorkbook2()Dim fname As StringMsgBox "將D盤中的 測試.xls工作簿以只 讀方式打 開"fname = "D:/ 測試.xls”Workbooks.Open Filename:=fname, ReadOnly:=TrueEnd Sub示例03-04：將文本文件導入工作簿中(OpenText方法)Sub TextToWorkbook()'本示例打開某文本文件并將制表符作為分隔符對此文件進行分列處理轉換成為工作表Workbooks.OpenText Filename:="文本文件所在的路徑 /

17、文本文件名",_DataType:=xlDelimited, Tab:=TrueEnd Sub示例說明：代碼中的 里的內容需用所 載入的文本文件所在路彳5及文件名代替。OpenText方法的作用是導入一個文本文件，并將其作 為包含單個工作表的工作簿 進行分列處理，然后在此工作表中放入 經過分列處理的文本文件數據。該方法共有18個參數，其中參數FileName為必需的參數，其余參數 可選。示例03-05 :保存工作簿(Save方法)示例 03-05-01Sub SaveWorkbook()MsgBox "保存當前工作簿."ActiveWorkbook.SaveEnd

18、 Sub示例 03-05-02Sub SaveAllWorkbook1()Dim wb As WorkbookMsgBox "保存所有打 開的工作簿后退出 Excel."For Each wb In Application.Workbookswb.SaveNext wbApplication.QuitEnd Sub示例 03-05-03Sub SaveAllWorkbook2()Dim wb As WorkbookFor Each wb In WorkbooksIf wb.Path <> "" Then wb.SaveNext wbEnd S

19、ub示例說明：本示例保存原來已存在且已打 開的工作簿。示例03-06 :保存工作簿(SaveAs方法)示例 03-06-01Sub SaveWorkbook1()MsgBox "將工作簿以指定名保存在默認文件夾中.”ActiveWorkbook.SaveAs "< 工作簿名 >.xls"End Sub示例說明：SaveAs方法相當于 另存為”命令，以指定名稱保存工作簿。該方法有12個參數，均為可選參數。如果未指定保存的路徑，那 么將在默認文件夾中保存該工作簿。如果文件 夾中該工作簿名 已存在，則提示是否替 換原工作簿。示例 03-06-02Sub Sa

20、veWorkbook2()Dim oldName As String, newName As StringDim folderName As String, fname As StringoldName = ActiveWorkbook.NamenewName = "new" & oldNameMsgBox "將<"& oldName & "> 以 <"& newName & "> 的名稱保存"folderName = Application.Defa

21、ultFilePathfname = folderName & "/" & newNameActiveWorkbook.SaveAs fnameEnd Sub示例說明：本示例將當前工作簿以一個新名(即new加原名)保存在默認文件夾中。示例 03-06-03Sub CreateBak1()MsgBox ”保存工作簿并建立 備份工彳簿"ActiveWorkbook.SaveAs CreateBackup:=TrueEnd Sub示例說明：本示例將在當前文件 夾中建立工作簿的 備份。示例 03-06-04Sub CreateBak2()MsgBox &q

22、uot;保存工作簿 時若已建立了備份，則將出現包含True的信息框，否則出現False."MsgBox ActiveWorkbook.CreateBackupEnd Sub示例03-07 :取得當前打開的工作簿數(Count屬性)Sub WorkbookNum()MsgBox "當前已打 開的工作簿數 為:"& Chr(10) & Workbooks.CountEnd Sub示例03-08 :激活工作簿(Activate方法)示例 03-08-01Sub ActivateWorkbook1()Workbooks("< 工作簿名 &g

23、t;").ActivateEnd Sub示例說明：Activate方法激活一個工作簿，使 該工作簿為當前工作簿。示例 03-08-02Sub ActivateWorkbook2()Dim n As Long, i As LongDim b As StringMsgBox "依次激活已 經打開的工作簿"n = Workbooks.CountFor i = 1 To nWorkbooks(i).Activateb = MsgBox("第"& i & "個工作簿被激活，還要繼續嗎？", vbYesNo)If b =

24、 vbNo Then Exit SubIf i = n Then MsgBox "最后一個工作簿已被激活 ."Next iEnd Sub示例03-09 :傷護工作簿(Protect方法)Sub ProtectWorkbook()MsgBox "保護工作簿 結構,密碼為123"ActiveWorkbook.Protect Password:="123", Structure:=TrueMsgBox "保護工作簿窗口，密碼為123"ActiveWorkbook.Protect Password:="123&q

25、uot;, Windows:=TrueMsgBox "保護工作簿結構和窗口，密碼為123"ActiveWorkbook.Protect Password:="123", Structure:=True, Windows:=TrueEnd Sub示例說明：使用Protect方法來保 護工作簿，帶有三個可 選參數，參數Password指明保護工作簿密 碼, 要解除工作簿保 護應輸入此密碼；參數Structure設置為True則保護工作簿結構，此時不能對工作簿 中的工作表 進行插入、復制、刪除等操作；參數Windows設置為True則保護工作簿窗口，此 時該工

26、作 簿右上角的最小化、最大化和關閉按鈕消失。示例03-10:解除工作簿保護(UnProtect方法)Sub UnprotectWorkbook()MsgBox "取消工作簿保護”ActiveWorkbook.Unprotect "123"End Sub示例03-11 :工作簿的一些通用屬性示例Sub testGeneralWorkbookInfo()MsgBox "本工作簿的名稱 為"& ActiveWorkbook.NameMsgBox "本工作簿 帶完整路徑的名稱 為"& ActiveWorkbook.F

27、ullNameMsgBox "本工作簿 對象的代碼名為"& ActiveWorkbook.CodeNameMsgBox "本工作簿的路徑 為"& ActiveWorkbook.PathIf ActiveWorkbook.ReadOnly ThenMsgBox "本工作簿已 經是以只 讀方式打 開”ElseMsgBox "本工作簿可讀寫.”End IfIf ActiveWorkbook.Saved ThenMsgBox "本工作簿已保存."ElseMsgBox "本工作簿需要保存."

28、;End IfEnd Sub示例03-12 ：訪問工作簿的內置屬性(BuiltinDocumentProperties 屬性)示例 03-12-01Sub ShowWorkbookProperties()Dim SaveTime As StringOn Error Resume NextSaveTime = ActiveWorkbook.BuiltinDocumentProperties("Last Save Time").ValueIf SaveTime = "" ThenMsgBox ActiveWorkbook.Name & "

29、工作簿未保存.”ElseMsgBox "本工作簿已于"& SaveTime & "保存",ActiveWorkbook.NameEnd IfEnd Sub示例說明：在Excel中選擇菜單文件一一屬性”命令時將會顯示一個 屬性”對話框，該對話框中包含了 當前工作簿的有 關信息，可以在VBA中使用BuiltinDocumentProperties 屬性訪問工作簿的屬性。上述 示例代碼將顯示當前工作簿保存 時的日期和 時間。示例 03-12-02Sub listWorkbookProperties()On Error Resume Next&#

30、39;在名為"工作簿屬性”的工作表中添加信息，若該工作表不存在，則新建一個工作表Worksheets。'工作簿屬性 .ActivateIf Err.Number <> 0 ThenWorksheets.Add after:=Worksheets(Worksheets.Count)ActiveSheet.Name =" 工作簿屬性"ElseActiveSheet.ClearEnd IfOn Error GoTo 0ListPropertiesEnd SubSub ListProperties()Dim i As LongCells(1, 1)=&

31、quot;名稱"Cells(1,2)="類型"Cells(1,3)="值"Range("A1:C1").Font.Bold = TrueWith ActiveWorkbookFor i = 1 To .BuiltinDocumentProperties.CountWith .BuiltinDocumentProperties(i)Cells(i + 1,1) = .NameSelect Case .TypeCase msoPropertyTypeBooleanCells(i + 1,2) = "Boolean&qu

32、ot;Case msoPropertyTypeDateCells(i + 1,2) = "Date"Case msoPropertyTypeFloatCells(i + 1,2) = "Float"Case msoPropertyTypeNumberCells(i + 1,2) = "Number"Case msoPropertyTypeStringCells(i + 1,2) = "string"End SelectOn Error Resume NextCells(i + 1,3) = .ValueOn Err

33、or GoTo 0End WithNext iEnd WithRange("A:C").Columns.AutoFitEnd Sub示例說明：本示例代碼在 工作簿屬性”工作表中列出了當前工作簿中的所有內置屬性。示例03-13 :測試工作簿中是否包含指定工作表(Sheets屬性)Sub testSheetExists()MsgBox "測試工作簿中是否存在指定名稱的工作表"Dim b As Booleanb = SheetExists("< 指定的工作表名 >")If b = True ThenMsgBox "該工

34、作表存在于工作簿中."ElseMsgBox "工作簿中沒有這個工作表."End IfEnd SubPrivate Function SheetExists(sname) As BooleanDim x As ObjectOn Error Resume NextSet x = ActiveWorkbook.Sheets(sname)If Err = 0 ThenSheetExists = TrueElseSheetExists = FalseEnd IfEnd Function示例03-14 :對未打開的工作簿 進行重命名(Name方法)Sub rename()Na

35、me "工作簿路徑/舊名稱.xls" As "工作簿路徑/新名稱.xls"End Sub示例說明：代碼中中的內容 為需要重命名的工作簿所在路徑及新舊名稱。該方法只是 對未打開的文件進行重命名，如果該文件已經打開，使用該方法會提示 錯誤。示例03-15 :設置數字精度(PrecisionAsDisplayed 屬性)Sub SetPrecision()Dim pValueMsgBox "在當前單元格中輸入1/3,并將結果算至小數點后兩位"ActiveCell.Value = 1 / 3ActiveCell.NumberFormatLoc

36、al = "0.00"pValue = ActiveCell.Value * 3MsgBox "當前單元格中的數字乘以 3等于："& pValueMsgBox "然后，將數值分類設置為數值即單元格中顯示的精度”ActiveWorkbook.PrecisionAsDisplayed = TruepValue = ActiveCell.Value * 3MsgBox "此時，當前單元格中的數字乘以3等于："& pValue & "而不是1"ActiveWorkbook.Precisio

37、nAsDisplayed = FalseEnd Sub示例說明：PrecisionAsDisplayed 屬性的值設置為True ,則表明采用 單元格中所 顯示的數值進行計管舁。示例03-16 :刪除自定 義數字格式(DeleteNumberFormat 方法)Sub DeleteNumberFormat。MsgBox "從當前工作簿中 刪除000-00-0000的數字格式"ActiveWorkbook.DeleteNumberFormat ("000-00-0000")End Sub示例說明：DeleteNumberFormat方法將從指定的工作簿中刪

38、除自定義的數字格式。示例03-17 :控制工作簿中圖形顯示(DisplatyDrawingObjects 屬性)Sub testDraw()MsgBox "隱藏當前工作簿中的所有 圖形”ActiveWorkbook.DisplayDrawingObjects = xlHideMsgBox "僅顯示當前工作簿中所有 圖形的占位符"ActiveWorkbook.DisplayDrawingObjects = xlPlaceholdersMsgBox "顯示當前工作簿中的所有 圖形"ActiveWorkbook.DisplayDrawingObjec

39、ts = xlDisplayShapesEnd Sub示例說明：本屬性作用的對象包括圖表和形狀。在應用本示例前，應保證工作簿中有 圖表或形狀，以察 看效果。示例03-18 :指定名稱(Names屬性)Sub testNames()MsgBox "將當前工作簿中工作表Sheet1內單元格A1命名為說明：對于Workbook對象而言，Names屬性返回的集合代表工作簿中的所有名稱。示例03-19 :檢查工作簿的自 動恢復功能(EnableAutoRecover屬性)Sub UseAutoRecover()檢查是否工作簿自 動恢復功能開啟，如果沒有則開啟該功能If ActiveWorkbo

40、ok.EnableAutoRecover = False ThenActiveWorkbook.EnableAutoRecover = TrueMsgBox "剛開啟自動恢復功能.”ElseMsgBox "自動恢復功能已開啟.”End IfEnd Sub示例03-20 ：設置工作簿密 碼(Password屬性)Sub UsePassword()Dim wb As WorkbookSet wb = Application.ActiveWorkbookwb.Password = InputBox(" 請輸入密碼:")wb.CloseEnd Sub示例說明：P

41、assword 屬性返回或 設置工作簿密 碼，在打開工作簿時必須輸入密碼。本示例代碼運行后, 提示設置密碼，然后關閉工作簿；再次打開工作簿時，要求輸入密碼。示例03-21 :返回工作簿用戶狀態信息戶名”.Cells(Row, 2)=" 日期和 時間".Cells(Row, 3)="使用方式"For Row = 1 To UBound(Users, 1).Cells(Row + 1,1) = Users(Row, 1).Cells(Row + 1,2) = Users(Row, 2)Select Case Users(Row, 3)Case 1.Cells

42、(Row + 1, 3).Value ="個人工作簿"Case 2.Cells(Row + 1, 3).Value ="共享工作簿"End SelectNextEnd WithRange("A:C").Columns.AutoFitEnd Sub示例說明：示例代碼運行后，將創建一個新工作簿并 帶有用戶使用當前工作簿的信息，即用 戶名、打開 的日期和 時間及工作簿使用方式。示例03-22 ：檢查工作簿是否有密 碼保護(HasPassword 屬性)Sub IsPassword()If ActiveWorkbook.HasPassword

43、 = True ThenMsgBox "本工作簿有密 碼保護，請在管理員處獲 取密碼.”ElseMsgBox"本工作簿無密 碼保護，您可以自由 編輯.”End IfEnd Sub示例03-23:決定列表邊框是否可見(InactiveListBorderVisible 屬性)Sub HideListBorders()MsgBox "隱藏當前工作簿中所有非活動列表的邊框.”ActiveWorkbook.InactiveListBorderVisible = FalseEnd Sub示例03-24 :關閉工作簿示例 03-24-01Sub CloseWorkbook1(

44、)Msgbox不保存所作的改 變而關閉本工作簿”ActiveWorkbook.Close False或 ActiveWorkbook.Close SaveChanges:=False或 ActiveWorkbook.Saved=TrueEnd sub示例 03-24-02Sub CloseWorkbook2()Msgbox保存所作的改 變并關閉本工作簿”ActiveWorkbook.Close TrueEnd sub示例 03-24-03Sub CloseWorkbook3()Msgbox關閉本工作簿。如果工作簿已 發生變化，則彈出是否保存更改的 對話框。”ActiveWorkbook.Clo

45、se TrueEnd sub示例03-24-04關閉并保存所有工作簿Sub CloseAllWorkbooks()Dim Book As WorkbookFor Each Book In WorkbooksIf Book.Name<>ThisWorkbook.Name ThenBook.Close savechanges:=TrueEnd IfNext BookThisWorkbook.Close savechanges:=TrueEnd Sub示例03-24-05關閉工作簿并將它徹底刪除Sub KillMe()With ThisWorkbook.Saved = True.Chan

46、geFileAccess Mode:=xlReadOnlyKill .FullName.Close FalseEnd WithEnd Sub示例03-24-06關閉所有工作簿，若工作簿已改 變則彈出是否保存 變化的對話框Sub closeAllWorkbook()MsgBox "關閉當前所打 開的所有工作簿"Workbooks.CloseEnd Sub工作簿(Workbook)基本操作應用示例(二)其它一些有 關操作工作簿的示例>示例03-25 ：創建新的工作簿Sub testNewWorkbook()MsgBox "創建一個 帶有10個工作表的新工作簿&q

47、uot;Dim wb as WorkbookSet wb = NewWorkbook(10)End SubFunction NewWorkbook(wsCount As Integer) As Workbook創建帶有由變量wsCount提定數量工作表的工作簿，工作表數在1至255之間Dim OriginalWorksheetCount As LongSet NewWorkbook = NothingIf wsCount < 1 Or wsCount > 255 Then Exit FunctionOriginalWorksheetCount = Application.Sheet

48、sInNewWorkbookApplication.SheetsInNewWorkbook = wsCountSet NewWorkbook = Workbooks.AddApplication.SheetsInNewWorkbook = OriginalWorksheetCountEnd Function示例說明：自定義函數NewWorkbook可以創建最多帶有255個工作表的工作簿。本 測試示例創建一 個帶有10個工作表的新工作簿。示例03-26 :判斷工作簿是否存在Sub testFileExists()MsgBox "如果文件不存在 則用信息框 說明，否則打開該文件.”If

49、Not FileExists("C:/ 文件夾/子文件 夾/文件.xls") ThenMsgBox "這個工作簿不存在！"ElseWorkbooks.Open "C:/ 文件夾/子文件夾/文件.xls"End IfEnd SubFunction FileExists(FullFileName As String) As Boolean'如果工作簿存在，則返回TrueFileExists = Len(Dir(FullFileName) > 0End Function示例說明：本示例使用自定 義函數FileExists判斷工

50、作簿是否存在，若 該工作簿已存在，則打開它。代 碼中，"C文件夾/子文件夾/文件.xls代表工作簿所在的文件 夾名、子文件夾名和工作簿文件名。示例03-27 :判斷工作簿是否已打開示例 03-27-01Sub testWorkbookOpen()MsgBox "如果工作簿未打 開，則打開該工作簿."If Not WorkbookOpen("工作簿名.xls") ThenWorkbooks.Open "工作簿名.xls"End IfEnd SubFunction WorkbookOpen(WorkBookName As Str

51、ing) As Boolean'如果該工作簿已打 開則返回真WorkbookOpen = FalseOn Error GoTo WorkBookNotOpenIf Len(Application.Workbooks(WorkBookName).Name) > 0 ThenWorkbookOpen = TrueMsgBox "該工作簿已打 開”Exit FunctionEnd IfWorkBookNotOpen:End Function示例說明：本示例中的函數 WorkbookOpen用來判斷工作簿是否打 開。代碼中，工作簿名.xls代表所 要打開的工作簿名稱。示例 03

52、-27-02Sub testWookbookIFOpen()Dim wb As StringDim bwb As Booleanwb ="<要判斷的工作簿名稱 >"bwb = WorkbookIsOpen(wb)If bwb = True ThenMsgBox"工作簿"& wb & "已打開."ElseMsgBox "工作簿"& wb & "未打 開."End IfEnd SubPrivate Function WorkbookIsOpen(wbnam

53、e) As BooleanDim x As WorkbookOn Error Resume NextSet x = Workbooks(wbname)If Err = 0 ThenWorkbooklsOpen = TrueElseWorkbooklsOpen = FalseEnd IfEnd Function示例03-28 :備份工作簿示例03-28-01用與活動工作簿相同的名字但后綴名為.bak備份工作簿Sub SaveWorkbookBackup()Dim awb As Workbook, BackupFileName As String, i As Integer, OK As Bool

54、eanIf TypeName(ActiveWorkbook) = "Nothing" Then Exit SubSet awb = ActiveWorkbookIf awb.Path = "" ThenApplication.Dialogs(xlDialogSaveAs).ShowElseBackupFileName = awb.FullNamei = 0While InStr(i + 1, BackupFileName, ".") > 0i = InStr(i + 1, BackupFileName, "."

55、;)WendIf i > 0 Then BackupFileName = Left(BackupFileName, i - 1)BackupFileName = BackupFileName & ".bak"OK = FalseOn Error GoTo NotAbleToSaveWith awbApplication.StatusBar =" 正在保存工作簿.".SaveApplication.StatusBar =" 正在備份工彳簿.".SaveCopyAs BackupFileNameOK = TrueEnd Wi

56、thEnd IfNotAbleToSave:Set awb = NothingApplication.StatusBar = FalseIf Not OK ThenMsgBox "備份工作簿未保存!", vbExclamation, ThisWorkbook.NameEnd If End Sub 示例說明：在當前工作簿中運行本示例代 碼后，將以與工作簿相同的名稱但后 綴名為.bak備份工作簿,且該備份與當前工作簿在同一文件夾中。其中，使用了工作簿的FullName屬性和SaveCopyAs方法。示例03-28-02保存當前工作簿的副本到其它位置備份工作簿Sub SaveWo

57、rkbookBackupToFloppyD()Dim awb As Workbook, BackupFileName As String, i As Integer, OK As BooleanIf TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub Set awb = ActiveWorkbookIf awb.Path = "" ThenApplication.Dialogs(xlDialogSaveAs).ShowElseBackupFileName = awb.NameOK = FalseOn Er

58、ror GoTo NotAbleToSaveIf Dir("D:/" & BackupFileName) <> "" Then Kill "D:/" & BackupFileNameEnd IfWith awbApplication.StatusBar =" 正在保存工作簿.".SaveApplication.StatusBar =" 正在備份工彳簿.".SaveCopyAs "D:/" & BackupFileName OK = True

59、End WithEnd IfNotAbleToSave:Set awb = NothingApplication.StatusBar = False If Not OK ThenMsgBox "備份工作簿未保存!", vbExclamation, ThisWorkbook.NameEnd If End Sub示例說明：本程序將把當前工作簿 進行復制并以與當前工作簿相同的名稱保存在D盤中。其中，使用了 Kill方法來刪除已存在的工作簿。示例03-29 :從已關閉的工作簿中取值示例 03-29-01Sub testGetValuesFromClosedWorkbook()Get

60、ValuesFromAClosedWorkbook "C:", "Book1.xls", "Sheetl", "A1:G20"End SubSub GetValuesFromAClosedWorkbook(fPath As String, _ fName As String, sName, cellRange As String) With ActiveSheet.Range(cellRange).FormulaArray = "='" & fPath & "/

61、" & fName & "" _& sName & "'!" & cellRange .Value = .ValueEnd With End Sub示例 說明：本示例包含一個子 過程GetValuesFromAClosedWorkbook ,用來從已關閉的工作簿中 獲取 數據，主過程testGetValuesFromClosedWorkbook用來傳遞參數。本示例表示從 C盤根目錄下的Book1.xls工作簿的工作表 Sheet1中的A1:G20單元格區域內 獲取數據，并將其 復制到當前工作表相 應單元格區域中。示例 03-29-02Sub ReadDataFromAllWorkbooksInFolder()Dim FolderName As String, wbName As String, r As Long, cValue As VariantDim wbList() As String, wbCount As Integer, i As IntegerFolderName = "C:/ 文件夾名&q