Excel VBA編程的常用代碼參考模板

1、Excel VBA編程的常用代碼        用過VB的人都應(yīng)該知道如何聲明變量，在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、Deci

2、mal（當(dāng)前不支持）、Date、String（只限變長字符串）、String * length（定長字符串）、Object、Variant、用戶定義類型或?qū)ο箢愋汀?qiáng)制聲明變量Option Explicit說明：該語句必在任何過程之前出現(xiàn)在模塊中。聲明常數(shù)用來代替文字值。Const ' 常數(shù)的默認(rèn)狀態(tài)是 Private。Const My = 456' 聲明 Public 常數(shù)。Public Const MyString = "HELP"' 聲明 Private Integer 常數(shù)。Private Const MyInt As Integer = 5

3、' 在同一行里聲明多個常數(shù)。Const MyStr = "Hello", MyDouble As Double = 3.4567 1 / 45選擇當(dāng)前單元格所在區(qū)域在EXCEL97中，有一個十分好的功能，他就是把鼠標(biāo)放置在一個有效數(shù)據(jù)單元格中，執(zhí)行該段代碼，你就可以將連在一起的一片數(shù)據(jù)全部選中。只要將該段代碼加入到你的模塊中。Sub My_SelectSelection.CurrentRegion.SelectEnd sub返回當(dāng)前單元格中數(shù)據(jù)刪除前后空格后的值sub my_trimmsgbox Trim(ActiveCell.Value)end sub單元格位移s

4、ub my_offsetActiveCell.Offset(0, 1).Select'當(dāng)前單元格向左移動一格ActiveCell.Offset(0, -1).Select'當(dāng)前單元格向右移動一格ActiveCell.Offset(1 , 0).Select'當(dāng)前單元格向下移動一格ActiveCell.Offset(-1 , 0).Select'當(dāng)前單元格向上移動一格end sub如果上述程序產(chǎn)生錯誤那是因?yàn)閱卧癫荒芤苿?，為了解除上述錯誤，我們可以往sub my_offset 之下加一段代碼 on error resume next 注意以下代碼都不再

5、添加 sub “代碼名稱” 和end sub請自己添加!給當(dāng)前單元格賦值A(chǔ)ctiveCell.Value = "你好！"給指定單元格賦值例如：單元格內(nèi)容設(shè)為""Range("a1").value="hello"又如：你現(xiàn)在的工作簿在sheet1上，你要往sheet2的單元格中插入""1.sheets("sheet2").selectrange("a1").value="hello"或2.Sheets("sheet1"

6、).Range("a1").Value = "hello"說明：1.sheet2被選中，然后在將“HELLO"賦到A1單元格中。2.sheet2不必被選中，即可“HELLO"賦到sheet2 的A1單元格中。隱藏工作表'隱藏SHEET1這張工作表sheets("sheet1").Visible=False'顯示SHEET1這張工作表sheets("sheet1").Visible=True打印預(yù)覽有時候我們想把所有的EXCEL中的SHEET都打印預(yù)覽，請使用該段代碼，它將在你現(xiàn)有

7、的工作簿中循環(huán)，直到最后一個工作簿結(jié)束循環(huán)預(yù)覽。Dim my As WorksheetFor Each my In Worksheetsmy.PrintPreviewNext my得到當(dāng)前單元格的地址msgbox ActiveCell.Address得到當(dāng)前日期及時間msgbox date & chr(13) & time保護(hù)工作簿ActiveSheet.Protect 取消保護(hù)工作簿ActiveSheet.Unprotect給活動工作表改名為 "liu"ActiveSheet.Name = "liu"打開一個應(yīng)用程序AppActivat

8、e (Shell("C:/WINDOWS/CALC.EXE")增加一個工作表Worksheets.Add刪除活動工作表activesheet.delete打開一個工作簿文件Workbooks.Open FileName:="C:/My Documents/Book2.xls"關(guān)閉活動窗口ActiveWindow.Close單元格格式選定單元格左對齊Selection.HorizontalAlignment = xlLeft選定單元格居中Selection.HorizontalAlignment = xlCenter選定單元格右對齊Selection.Ho

9、rizontalAlignment = xlRight選定單元格為百分號風(fēng)格Selection.Style = "Percent"選定單元格字體為粗體Selection.Font.Bold = True選定單元格字體為斜體Selection.Font.Italic = True選定單元格字體為宋體20號字With Selection.Font.Name = "宋體".Size = 20End WithWith 語句With 對象.描述End With清除單元格ActiveCell.Clear  '刪除所有文字、批注、格式返回選定區(qū)域的行

10、數(shù)MsgBox Selection.Rows.Count返回選定區(qū)域的列數(shù)MsgBox Selection.Columns.Count返回選定區(qū)域的地址Selection.Address忽略所有的錯誤ON ERROR RESUME NEXT遇錯跳轉(zhuǎn)on error goto err_handle'中間的其他代碼err_handle: ' 標(biāo)簽'跳轉(zhuǎn)后的代碼刪除一個文件kill "c:/1.txt"定制自己的狀態(tài)欄Application.StatusBar = "現(xiàn)在時刻: " & Time恢復(fù)自己的狀態(tài)欄Applicati

11、on.StatusBar = false用代碼執(zhí)行一個宏Application.Run macro:="text"滾動窗口到a1的位置ActiveWindow.ScrollRow = 1ActiveWindow.ScrollColumn = 1定制系統(tǒng)日期Dim MyDate, MyDayMyDate = #12/12/69#MyDay = Day(MyDate)返回當(dāng)天的時間Dim MyDate, MyYearMyDate = Date MyYear = Year(MyDate)MsgBox MyYear inputbox<輸入框>XX=InputBox (&

12、quot;Enter number of months to add")得到一個文件名Dim kk As Stringkk = Application.GetOpenFilename("EXCEL (*.XLS), *.XLS", Title:="提示：請打開一個EXCEL文件：")msgbox kk打開zoom對話框Application.Dialogs(xlDialogZoom).Show激活字體對話框Application.Dialogs(xlDialogActiveCellFont).Show打開另存對話框Dim kk As Strin

13、gkk = Application.GetSaveAsFilename("excel (*.xls), *.xls")Workbooks.Open kk工作簿(Workbook)基本操作應(yīng)用示例(一)Workbook對象代表工作簿，而Workbooks集合則包含了當(dāng)前所有的工作簿。下面對Workbook對象的重要的方法和屬性以及其它一些可能涉及到的方法和屬性進(jìn)行示例介紹，同時，后面的示例也深入介紹了一些工作簿對象操作的方法和技巧。示例03-01：創(chuàng)建工作簿(Add方法)示例03-01-01Sub CreateNewWorkbook1()  MsgBox "

14、;將創(chuàng)建一個新工作簿."  Workbooks.AddEnd Sub示例03-01-02Sub CreateNewWorkbook2()  Dim wb As Workbook  Dim ws As Worksheet  Dim i As Long  MsgBox "將創(chuàng)建一個新工作簿,并預(yù)設(shè)工作表格式."  Set wb = Workbooks.Add  Set ws = wb.Sheets(1)  ws.Name = "產(chǎn)品匯總表"  ws.Cells

15、(1, 1) = "序號"  ws.Cells(1, 2) = "產(chǎn)品名稱"  ws.Cells(1, 3) = "產(chǎn)品數(shù)量"  For i = 2 To 10    ws.Cells(i, 1) = i - 1  Next iEnd Sub示例03-02：添加并保存新工作簿Sub AddSaveAsNewWorkbook() Dim Wk As Workbook Set Wk = Workbooks.Add Application.D

16、isplayAlerts = False Wk.SaveAs Filename:="D:/SalesData.xls"End Sub示例說明：本示例使用了Add方法和SaveAs方法，添加一個新工作簿并將該工作簿以文件名SalesData.xls保存在D盤中。其中，語句Application.DisplayAlerts = False表示禁止彈出警告對話框。示例03-03：打開工作簿(Open方法)示例03-03-01Sub openWorkbook1()    Workbooks.Open "<需打開文件的路徑>

17、;/<文件名>"End Sub示例說明：代碼中的<>里的內(nèi)容需用所需打開的文件的路徑及文件名代替。Open方法共有15個參數(shù)，其中參數(shù)FileName為必需的參數(shù)，其余參數(shù)可選。示例03-03-02Sub openWorkbook2()  Dim fname As String  MsgBox "將D盤中的<測試.xls>工作簿以只讀方式打開"  fname = "D:/測試.xls"  Workbooks.Open Filename:=fname, ReadOnly:

18、=TrueEnd Sub示例03-04：將文本文件導(dǎo)入工作簿中(OpenText方法)Sub TextToWorkbook()  '本示例打開某文本文件并將制表符作為分隔符對此文件進(jìn)行分列處理轉(zhuǎn)換成為工作表  Workbooks.OpenText Filename:="<文本文件所在的路徑>/<文本文件名>", _      DataType:=xlDelimited, Tab:=TrueEnd Sub示例說明：代碼中的<>里的內(nèi)容需用所載入的文本文件所在路徑及

19、文件名代替。OpenText方法的作用是導(dǎo)入一個文本文件，并將其作為包含單個工作表的工作簿進(jìn)行分列處理，然后在此工作表中放入經(jīng)過分列處理的文本文件數(shù)據(jù)。該方法共有18個參數(shù)，其中參數(shù)FileName為必需的參數(shù)，其余參數(shù)可選。示例03-05：保存工作簿(Save方法)示例03-05-01Sub SaveWorkbook()  MsgBox "保存當(dāng)前工作簿."  ActiveWorkbook.SaveEnd Sub示例03-05-02Sub SaveAllWorkbook1()  Dim wb As Workbook  MsgBox

20、"保存所有打開的工作簿后退出Excel."  For Each wb In Application.Workbooks    wb.Save  Next wb  Application.QuitEnd Sub示例03-05-03Sub SaveAllWorkbook2()  Dim wb As Workbook  For Each wb In Workbooks    If wb.Path <> "" Then wb.Save

21、0; Next wbEnd Sub示例說明：本示例保存原來已存在且已打開的工作簿。示例03-06：保存工作簿(SaveAs方法)示例03-06-01Sub SaveWorkbook1()  MsgBox "將工作簿以指定名保存在默認(rèn)文件夾中."  ActiveWorkbook.SaveAs "<工作簿名>.xls"End Sub示例說明：SaveAs方法相當(dāng)于“另存為”命令，以指定名稱保存工作簿。該方法有12個參數(shù)，均為可選參數(shù)。如果未指定保存的路徑，那么將在默認(rèn)文件夾中保存該工作簿。如果文件夾中該工作簿名已存在，則提示是

22、否替換原工作簿。示例03-06-02Sub SaveWorkbook2()  Dim oldName As String, newName As String  Dim folderName As String, fname As String  oldName = ActiveWorkbook.Name  newName = "new" & oldName  MsgBox "將<" & oldName & ">以<" & newNam

23、e & ">的名稱保存"  folderName = Application.DefaultFilePath  fname = folderName & "/" & newName  ActiveWorkbook.SaveAs fnameEnd Sub示例說明：本示例將當(dāng)前工作簿以一個新名(即new加原名)保存在默認(rèn)文件夾中。示例03-06-03Sub CreateBak1()  MsgBox "保存工作簿并建立備份工作簿"  ActiveWorkbook

24、.SaveAs CreateBackup:=TrueEnd Sub示例說明：本示例將在當(dāng)前文件夾中建立工作簿的備份。示例03-06-04Sub CreateBak2()  MsgBox "保存工作簿時,若已建立了備份,則將出現(xiàn)包含True的信息框,否則出現(xiàn)False."  MsgBox ActiveWorkbook.CreateBackupEnd Sub示例03-07：取得當(dāng)前打開的工作簿數(shù)(Count屬性)Sub WorkbookNum()  MsgBox "當(dāng)前已打開的工作簿數(shù)為:" & Chr(10) &

25、; Workbooks.CountEnd Sub示例03-08：激活工作簿(Activate方法)示例03-08-01Sub ActivateWorkbook1()  Workbooks("<工作簿名>").ActivateEnd Sub示例說明：Activate方法激活一個工作簿，使該工作簿為當(dāng)前工作簿。示例03-08-02Sub ActivateWorkbook2()  Dim n As Long, i As Long  Dim b As String  MsgBox "依次激活已經(jīng)打開的工作簿"&

26、#160; n = Workbooks.Count  For i = 1 To n    Workbooks(i).Activate    b = MsgBox("第 " & i & "個工作簿被激活，還要繼續(xù)嗎?", vbYesNo)    If b = vbNo Then Exit Sub    If i = n Then MsgBox "最后一個工作簿已被激活."  Next

27、 iEnd Sub示例03-09：保護(hù)工作簿(Protect方法)Sub ProtectWorkbook()  MsgBox "保護(hù)工作簿結(jié)構(gòu),密碼為123"  ActiveWorkbook.Protect Password:="123", Structure:=True  MsgBox "保護(hù)工作簿窗口,密碼為123"  ActiveWorkbook.Protect Password:="123", Windows:=True  MsgBox "保護(hù)工作

28、簿結(jié)構(gòu)和窗口,密碼為123"  ActiveWorkbook.Protect Password:="123", Structure:=True, Windows:=TrueEnd Sub示例說明：使用Protect方法來保護(hù)工作簿，帶有三個可選參數(shù)，參數(shù)Password指明保護(hù)工作簿密碼，要解除工作簿保護(hù)應(yīng)輸入此密碼；參數(shù)Structure設(shè)置為True則保護(hù)工作簿結(jié)構(gòu)，此時不能對工作簿中的工作表進(jìn)行插入、復(fù)制、刪除等操作；參數(shù)Windows設(shè)置為True則保護(hù)工作簿窗口，此時該工作簿右上角的最小化、最大化和關(guān)閉按鈕消失。示例03-10：解除工作簿保護(hù)(

29、UnProtect方法)Sub UnprotectWorkbook()  MsgBox "取消工作簿保護(hù)"  ActiveWorkbook.Unprotect "123"End Sub示例03-11：工作簿的一些通用屬性示例Sub testGeneralWorkbookInfo()  MsgBox "本工作簿的名稱為" & ActiveWorkbook.Name  MsgBox "本工作簿帶完整路徑的名稱為" & ActiveWorkbook.FullName

30、  MsgBox "本工作簿對象的代碼名為" & ActiveWorkbook.CodeName  MsgBox "本工作簿的路徑為" & ActiveWorkbook.Path  If ActiveWorkbook.ReadOnly Then    MsgBox "本工作簿已經(jīng)是以只讀方式打開"  Else    MsgBox "本工作簿可讀寫."  End If  If Act

31、iveWorkbook.Saved Then    MsgBox "本工作簿已保存."  Else    MsgBox "本工作簿需要保存."  End IfEnd Sub示例03-12：訪問工作簿的內(nèi)置屬性(BuiltinDocumentProperties屬性)示例03-12-01Sub ShowWorkbookProperties()  Dim SaveTime As String  On Error Resume Next  SaveTi

32、me = ActiveWorkbook.BuiltinDocumentProperties("Last Save Time").Value  If SaveTime = "" Then    MsgBox ActiveWorkbook.Name & "工作簿未保存."  Else    MsgBox "本工作簿已于" & SaveTime & "保存", , ActiveWorkbook.Na

33、me  End IfEnd Sub示例說明：在Excel中選擇菜單“文件屬性”命令時將會顯示一個“屬性”對話框，該對話框中包含了當(dāng)前工作簿的有關(guān)信息，可以在VBA中使用BuiltinDocumentProperties屬性訪問工作簿的屬性。上述示例代碼將顯示當(dāng)前工作簿保存時的日期和時間。示例03-12-02Sub listWorkbookProperties()  On Error Resume Next  '在名為"工作簿屬性"的工作表中添加信息,若該工作表不存在,則新建一個工作表  Worksheets("工作簿

34、屬性").Activate  If Err.Number <> 0 Then    Worksheets.Add after:=Worksheets(Worksheets.Count)    ActiveSheet.Name = "工作簿屬性"  Else    ActiveSheet.Clear  End If  On Error GoTo 0  ListPropertiesEnd Sub- - - - - -

35、- - - - - - - - - - - - - - - - - Sub ListProperties()  Dim i As Long  Cells(1, 1) = "名稱"  Cells(1, 2) = "類型"  Cells(1, 3) = "值"  Range("A1:C1").Font.Bold = True  With ActiveWorkbook    For i = 1 To .BuiltinDocument

36、Properties.Count      With .BuiltinDocumentProperties(i)        Cells(i + 1, 1) = .Name        Select Case .Type          Case msoPropertyTypeBoolean  

37、;          Cells(i + 1, 2) = "Boolean"          Case msoPropertyTypeDate            Cells(i + 1, 2) = "Date"    

38、60;     Case msoPropertyTypeFloat            Cells(i + 1, 2) = "Float"          Case msoPropertyTypeNumber          

39、0; Cells(i + 1, 2) = "Number"          Case msoPropertyTypeString            Cells(i + 1, 2) = "string"        End Select    

40、    On Error Resume Next        Cells(i + 1, 3) = .Value        On Error GoTo 0      End With    Next i  End With  Range("A:C").Columns.AutoFitEnd Sub示例說明：

41、本示例代碼在“工作簿屬性”工作表中列出了當(dāng)前工作簿中的所有內(nèi)置屬性。示例03-13：測試工作簿中是否包含指定工作表(Sheets屬性)Sub testSheetExists()  MsgBox "測試工作簿中是否存在指定名稱的工作表"  Dim b As Boolean  b = SheetExists("<指定的工作表名>")  If b = True Then    MsgBox "該工作表存在于工作簿中."  Else 

42、0;  MsgBox "工作簿中沒有這個工作表."  End IfEnd Sub- - - - - - - - - - - - - - - - - - - - - - - Private Function SheetExists(sname) As Boolean  Dim x As Object  On Error Resume Next  Set x = ActiveWorkbook.Sheets(sname)  If Err = 0 Then    SheetExists = T

43、rue  Else    SheetExists = False  End IfEnd Function示例03-14：對未打開的工作簿進(jìn)行重命名(Name方法)Sub rename()  Name "<工作簿路徑>/<舊名稱>.xls" As "<工作簿路徑>/<新名稱>.xls"End Sub示例說明：代碼中<>中的內(nèi)容為需要重命名的工作簿所在路徑及新舊名稱。該方法只是對未打開的文件進(jìn)行重命名，如果該文件已經(jīng)打開，使用該方法會提示錯

44、誤。示例03-15：設(shè)置數(shù)字精度(PrecisionAsDisplayed屬性)Sub SetPrecision()  Dim pValue  MsgBox "在當(dāng)前單元格中輸入1/3，并將結(jié)果算至小數(shù)點(diǎn)后兩位"  ActiveCell.Value = 1 / 3  ActiveCell.NumberFormatLocal = "0.00"  pValue = ActiveCell.Value * 3  MsgBox "當(dāng)前單元格中的數(shù)字乘以3等于：" & pValu

45、e  MsgBox "然后,將數(shù)值分類設(shè)置為數(shù)值,即單元格中顯示的精度"  ActiveWorkbook.PrecisionAsDisplayed = True  pValue = ActiveCell.Value * 3  MsgBox "此時,當(dāng)前單元格中的數(shù)字乘以3等于：" & pValue & "而不是1"  ActiveWorkbook.PrecisionAsDisplayed = FalseEnd Sub示例說明：PrecisionAsDisplayed屬性

46、的值設(shè)置為True，則表明采用單元格中所顯示的數(shù)值進(jìn)行計算。示例03-16：刪除自定義數(shù)字格式(DeleteNumberFormat方法)Sub DeleteNumberFormat()  MsgBox "從當(dāng)前工作簿中刪除000-00-0000的數(shù)字格式"  ActiveWorkbook.DeleteNumberFormat ("000-00-0000")End Sub示例說明：DeleteNumberFormat方法將從指定的工作簿中刪除自定義的數(shù)字格式。示例03-17：控制工作簿中圖形顯示(DisplatyDrawingObje

47、cts屬性)Sub testDraw()  MsgBox "隱藏當(dāng)前工作簿中的所有圖形"  ActiveWorkbook.DisplayDrawingObjects = xlHide  MsgBox "僅顯示當(dāng)前工作簿中所有圖形的占位符"  ActiveWorkbook.DisplayDrawingObjects = xlPlaceholders  MsgBox "顯示當(dāng)前工作簿中的所有圖形"  ActiveWorkbook.DisplayDrawingObjects = x

48、lDisplayShapesEnd Sub示例說明：本屬性作用的對象包括圖表和形狀。在應(yīng)用本示例前，應(yīng)保證工作簿中有圖表或形狀，以察看效果。示例03-18：指定名稱(Names屬性)Sub testNames()  MsgBox "將當(dāng)前工作簿中工作表Sheet1內(nèi)單元格A1命名為myName."  ActiveWorkbook.Names.Add Name:="myName", RefersToR1C1:="=Sheet1!R1C1"End Sub示例說明：對于Workbook對象而言，Names屬性返回的集合代

49、表工作簿中的所有名稱。示例03-19：檢查工作簿的自動恢復(fù)功能(EnableAutoRecover屬性)Sub UseAutoRecover()  '檢查是否工作簿自動恢復(fù)功能開啟,如果沒有則開啟該功能  If ActiveWorkbook.EnableAutoRecover = False Then    ActiveWorkbook.EnableAutoRecover = True    MsgBox "剛開啟自動恢復(fù)功能."  Else   

50、 MsgBox "自動恢復(fù)功能已開啟."  End IfEnd Sub示例03-20：設(shè)置工作簿密碼(Password屬性)Sub UsePassword()  Dim wb As Workbook  Set wb = Application.ActiveWorkbook  wb.Password = InputBox("請輸入密碼:")  wb.CloseEnd Sub示例說明：Password屬性返回或設(shè)置工作簿密碼，在打開工作簿時必須輸入密碼。本示例代碼運(yùn)行后，提示設(shè)置密碼，然后關(guān)閉工作簿；再次打開

51、工作簿時，要求輸入密碼。示例03-21：返回工作簿用戶狀態(tài)信息(UserStatus屬性)Sub UsePassword()  Dim Users As Variant  Dim Row As Long  Users = ActiveWorkbook.UserStatus  Row = 1  With Workbooks.Add.Sheets(1)    .Cells(Row, 1) = "用戶名"    .Cells(Row, 2) = "日期和時間&q

52、uot;    .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) &#

53、160;      Case 1          .Cells(Row + 1, 3).Value = "個人工作簿"        Case 2          .Cells(Row + 1, 3).Value = "共享工作簿"  

54、    End Select    Next  End With  Range("A:C").Columns.AutoFitEnd Sub示例說明：示例代碼運(yùn)行后，將創(chuàng)建一個新工作簿并帶有用戶使用當(dāng)前工作簿的信息，即用戶名、打開的日期和時間及工作簿使用方式。示例03-22：檢查工作簿是否有密碼保護(hù)(HasPassword屬性)Sub IsPassword()  If ActiveWorkbook.HasPassword = True Then    Msg

55、Box "本工作簿有密碼保護(hù),請在管理員處獲取密碼."  Else    MsgBox "本工作簿無密碼保護(hù),您可以自由編輯."  End IfEnd Sub示例03-23：決定列表邊框是否可見(InactiveListBorderVisible屬性)Sub HideListBorders()  MsgBox "隱藏當(dāng)前工作簿中所有非活動列表的邊框."  ActiveWorkbook.InactiveListBorderVisible = FalseEnd Sub示

56、例03-24：關(guān)閉工作簿示例03-24-01 Sub CloseWorkbook1()Msgbox “不保存所作的改變而關(guān)閉本工作簿”ActiveWorkbook.Close False或ActiveWorkbook.Close SaveChanges:=False或ActiveWorkbook.Saved=TrueEnd sub示例03-24-02 Sub CloseWorkbook2()Msgbox “保存所作的改變并關(guān)閉本工作簿”ActiveWorkbook.Close TrueEnd sub示例03-24-03 Sub CloseWorkbook3()Msgbox “關(guān)閉本工作簿。如果

57、工作簿已發(fā)生變化，則彈出是否保存更改的對話框?！盇ctiveWorkbook.Close TrueEnd sub示例03-24-04 關(guān)閉并保存所有工作簿Sub CloseAllWorkbooks()  Dim Book As Workbook  For Each Book In WorkbooksIf Book.Name<>ThisWorkbook.Name ThenBook.Close savechanges:=TrueEnd IfNext BookThisWorkbook.Close savechanges:=TrueEnd Sub示例03-24-05 關(guān)

58、閉工作簿并將它徹底刪除Sub KillMe() With ThisWorkbook .Saved = True .ChangeFileAccess Mode:=xlReadOnly Kill .FullName .Close False End WithEnd Sub示例03-24-06關(guān)閉所有工作簿，若工作簿已改變則彈出是否保存變化的對話框Sub closeAllWorkbook()  MsgBox "關(guān)閉當(dāng)前所打開的所有工作簿"  Workbooks.CloseEnd Sub 工作簿(Workbook)基本操作應(yīng)用示例(二) <其它一

59、些有關(guān)操作工作簿的示例>示例03-25：創(chuàng)建新的工作簿Sub testNewWorkbook()MsgBox "創(chuàng)建一個帶有10個工作表的新工作簿"Dim wb as WorkbookSet wb = NewWorkbook(10)End Sub- - - - - - - - - - - - - - - - - - - - - - - Function NewWorkbook(wsCount As Integer) As Workbook'創(chuàng)建帶有由變量wsCount提定數(shù)量工作表的工作簿，工作表數(shù)在1至255之間Dim OriginalWorksheetCo

60、unt As Long  Set NewWorkbook = Nothing  If wsCount < 1 Or wsCount > 255 Then Exit Function  OriginalWorksheetCount = Application.SheetsInNewWorkbook  Application.SheetsInNewWorkbook = wsCountSet NewWorkbook = Workbooks.Add  Application.SheetsInNewWorkbook = OriginalWor

61、ksheetCountEnd Function示例說明：自定義函數(shù)NewWorkbook可以創(chuàng)建最多帶有255個工作表的工作簿。本測試示例創(chuàng)建一個帶有10個工作表的新工作簿。示例03-26：判斷工作簿是否存在Sub testFileExists()  MsgBox "如果文件不存在則用信息框說明,否則打開該文件."  If Not FileExists("C:/文件夾/子文件夾/文件.xls") Then    MsgBox "這個工作簿不存在!"  Else &#

62、160;  Workbooks.Open "C:/文件夾/子文件夾/文件.xls"  End IfEnd Sub- - - - - - - - - - - - - - - - - - - - - - - Function FileExists(FullFileName As String) As Boolean  '如果工作簿存在,則返回True  FileExists = Len(Dir(FullFileName) > 0End Function示例說明：本示例使用自定義函數(shù)FileExists判斷工作簿是否存在，若該

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

64、- - - - - - - - - - - - - - Function WorkbookOpen(WorkBookName As String) As Boolean  '如果該工作簿已打開則返回真  WorkbookOpen = False  On Error GoTo WorkBookNotOpen  If Len(Application.Workbooks(WorkBookName).Name) > 0 Then    WorkbookOpen = True    MsgB

65、ox "該工作簿已打開"    Exit Function  End IfWorkBookNotOpen:End Function示例說明：本示例中的函數(shù)WorkbookOpen用來判斷工作簿是否打開。代碼中，“工作簿名.xls”代表所要打開的工作簿名稱。示例03-27-02Sub testWookbookIFOpen()  Dim wb As String  Dim bwb As Boolean  wb = "<要判斷的工作簿名稱>"  bwb = Workbo

66、okIsOpen(wb)  If bwb = True Then    MsgBox "工作簿" & wb & "已打開."  Else    MsgBox "工作簿" & wb & "未打開."  End IfEnd Sub- - - - - - - - - - - - - - - - - - - - - - - Private Function WorkbookIsOpen(wbname)

67、As Boolean  Dim x As Workbook  On Error Resume Next  Set x = Workbooks(wbname)  If Err = 0 Then    WorkbookIsOpen = True  Else    WorkbookIsOpen = False  End IfEnd Function示例03-28：備份工作簿示例03-28-01 用與活動工作簿相同的名字但后綴名為.bak備份工作簿Sub SaveWorkbookBa

68、ckup()  Dim awb As Workbook, BackupFileName As String, i As Integer, OK As Boolean  If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub  Set awb = ActiveWorkbook  If awb.Path = "" Then    Application.Dialogs(xlDialogSaveAs).Show  Else

69、0;   BackupFileName = awb.FullName    i = 0    While InStr(i + 1, BackupFileName, ".") > 0      i = InStr(i + 1, BackupFileName, ".")    Wend    If i > 0 Then BackupFileName = Lef

70、t(BackupFileName, i - 1)    BackupFileName = BackupFileName & ".bak"    OK = False    On Error GoTo NotAbleToSave    With awb      Application.StatusBar = "正在保存工作簿."    &#

71、160; .Save      Application.StatusBar = "正在備份工作簿."      .SaveCopyAs BackupFileName      OK = True    End With  End IfNotAbleToSave:  Set awb = Nothing  Application.StatusBar = False  If Not OK Then    MsgBox "備份工作簿未保存!", vbExclamation, ThisWorkbook.Name  End IfEnd Sub示例說明：在當(dāng)前工作簿中運(yùn)行本示例代碼后，將以與工作簿相同的名稱但后綴名為.bak備份工作簿，且該備份與當(dāng)前工作簿在同一文件夾中。其中，使用了工作簿的FullName屬性和SaveCopyAs方法。示