Workbook對(duì)象代表工作簿，而Workbooks集合則包含了當(dāng)前所有的工作簿。下面對(duì)Workbook對(duì)象的重要的方法和屬性以及其它一些可能涉及到的方法和屬性進(jìn)行示例介紹，同時(shí)，后面的示例也深入介紹了一些工作簿對(duì)象操作的方法和技巧。
示例03-01：創(chuàng)建工作簿(Add方法)
[示例03-01-01]
Sub CreateNewWorkbook1()
MsgBox "將創(chuàng)建一個(gè)新工作簿."
Workbooks.Add
End Sub
[示例03-01-02]
Sub CreateNewWorkbook2()
Dim wb As Workbook
Dim ws As Worksheet
Dim i As Long
MsgBox "將創(chuàng)建一個(gè)新工作簿,并預(yù)設(shè)工作表格式."
Set wb = Workbooks.Add
Set ws = wb.Sheets(1)
ws.Name = "產(chǎn)品匯總表"
ws.Cells(1, 1) = "序號(hào)"
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 i
End Sub
示例03-02：添加并保存新工作簿
Sub AddSaveAsNewWorkbook()
Dim Wk As Workbook
Set Wk = Workbooks.Add
Application.DisplayAlerts = False
Wk.SaveAs Filename:="D:/SalesData.xls"
End Sub
示例說(shuō)明：本示例使用了Add方法和SaveAs方法，添加一個(gè)新工作簿并將該工作簿以文件名SalesData.xls保存在D盤中。其中，語(yǔ)句Application.DisplayAlerts = False表示禁止彈出警告對(duì)話框。
示例03-03：打開工作簿(Open方法)
[示例03-03-01]
Sub openWorkbook1()
Workbooks.Open "<需打開文件的路徑>\<文件名>"
End Sub
示例說(shuō)明：代碼中的<>里的內(nèi)容需用所需打開的文件的路徑及文件名代替。Open方法共有15個(gè)參數(shù)，其中參數(shù)FileName為必需的參數(shù)，其余參數(shù)可選。
[示例03-03-02]
Sub openWorkbook2()
Dim fname As String
MsgBox "將D盤中的<測(cè)試.xls>工作簿以只讀方式打開"
fname = "D:\測(cè)試.xls"
Workbooks.Open Filename:=fname, ReadOnly:=True
End Sub
示例03-04：將文本文件導(dǎo)入工作簿中(OpenText方法)
Sub TextToWorkbook()
'本示例打開某文本文件并將制表符作為分隔符對(duì)此文件進(jìn)行分列處理轉(zhuǎn)換成為工作表
Workbooks.OpenText Filename:="<文本文件所在的路徑>/<文本文件名>", _
DataType:=xlDelimited, Tab:=True
End Sub
示例說(shuō)明：代碼中的<>里的內(nèi)容需用所載入的文本文件所在路徑及文件名代替。OpenText方法的作用是導(dǎo)入一個(gè)文本文件，并將其作為包含單個(gè)工作表的工作簿進(jìn)行分列處理，然后在此工作表中放入經(jīng)過(guò)分列處理的文本文件數(shù)據(jù)。該方法共有18個(gè)參數(shù)，其中參數(shù)FileName為必需的參數(shù)，其余參數(shù)可選。
示例03-05：保存工作簿(Save方法)
[示例03-05-01]
Sub SaveWorkbook()
MsgBox "保存當(dāng)前工作簿."
ActiveWorkbook.Save
End Sub
[示例03-05-02]
Sub SaveAllWorkbook1()
Dim wb As Workbook
MsgBox "保存所有打開的工作簿后退出Excel."
For Each wb In Application.Workbooks
wb.Save
Next wb
Application.Quit
End Sub
[示例03-05-03]
Sub SaveAllWorkbook2()
Dim wb As Workbook
For Each wb In Workbooks
If wb.Path <> "" Then wb.Save
Next wb
End Sub
示例說(shuō)明：本示例保存原來(lái)已存在且已打開的工作簿。
示例03-06：保存工作簿(SaveAs方法)
[示例03-06-01]
Sub SaveWorkbook1()
MsgBox "將工作簿以指定名保存在默認(rèn)文件夾中."
ActiveWorkbook.SaveAs "<工作簿名>.xls"
End Sub
示例說(shuō)明：SaveAs方法相當(dāng)于“另存為……”命令，以指定名稱保存工作簿。該方法有12個(gè)參數(shù)，均為可選參數(shù)。如果未指定保存的路徑，那么將在默認(rèn)文件夾中保存該工作簿。如果文件夾中該工作簿名已存在，則提示是否替換原工作簿。
[示例03-06-02]
Sub SaveWorkbook2()
Dim oldName As String, newName As String
Dim folderName As String, fname As String
oldName = ActiveWorkbook.Name
newName = "new" & oldName
MsgBox "將<" & oldName & ">以<" & newName & ">的名稱保存"
folderName = Application.DefaultFilePath
fname = folderName & "\" & newName
ActiveWorkbook.SaveAs fname
End Sub
示例說(shuō)明：本示例將當(dāng)前工作簿以一個(gè)新名(即new加原名)保存在默認(rèn)文件夾中。
[示例03-06-03]
Sub CreateBak1()
MsgBox "保存工作簿并建立備份工作簿"
ActiveWorkbook.SaveAs CreateBackup:=True
End Sub
示例說(shuō)明：本示例將在當(dāng)前文件夾中建立工作簿的備份。
[示例03-06-04]
Sub CreateBak2()
MsgBox "保存工作簿時(shí),若已建立了備份,則將出現(xiàn)包含True的信息框,否則出現(xiàn)False."
MsgBox ActiveWorkbook.CreateBackup
End Sub
示例03-07：取得當(dāng)前打開的工作簿數(shù)(Count屬性)
Sub WorkbookNum()
MsgBox "當(dāng)前已打開的工作簿數(shù)為:" & Chr(10) & Workbooks.Count
End Sub
[NextPage] 示例03-08：激活工作簿(Activate方法)
[示例03-08-01]
Sub ActivateWorkbook1()
Workbooks("<工作簿名>").Activate
End Sub
示例說(shuō)明：Activate方法激活一個(gè)工作簿，使該工作簿為當(dāng)前工作簿。
[示例03-08-02]
Sub ActivateWorkbook2()
Dim n As Long, i As Long
Dim b As String
MsgBox "依次激活已經(jīng)打開的工作簿"
n = Workbooks.Count
For i = 1 To n
Workbooks(i).Activate
b = MsgBox("第 " & i & "個(gè)工作簿被激活，還要繼續(xù)嗎?", vbYesNo)
If b = vbNo Then Exit Sub
If i = n Then MsgBox "最后一個(gè)工作簿已被激活."
Next i
End 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ù)工作簿結(jié)構(gòu)和窗口,密碼為123"
ActiveWorkbook.Protect Password:="123", Structure:=True, Windows:=True
End Sub
示例說(shuō)明：使用Protect方法來(lái)保護(hù)工作簿，帶有三個(gè)可選參數(shù)，參數(shù)Password指明保護(hù)工作簿密碼，要解除工作簿保護(hù)應(yīng)輸入此密碼；參數(shù)Structure設(shè)置為True則保護(hù)工作簿結(jié)構(gòu)，此時(shí)不能對(duì)工作簿中的工作表進(jìn)行插入、復(fù)制、刪除等操作；參數(shù)Windows設(shè)置為True則保護(hù)工作簿窗口，此時(shí)該工作簿右上角的最小化、最大化和關(guān)閉按鈕消失。
示例03-10：解除工作簿保護(hù)(UnProtect方法)
Sub UnprotectWorkbook()
MsgBox "取消工作簿保護(hù)"
ActiveWorkbook.Unprotect "123"
End Sub
示例03-11：工作簿的一些通用屬性示例
Sub testGeneralWorkbookInfo()
MsgBox "本工作簿的名稱為" & ActiveWorkbook.Name
MsgBox "本工作簿帶完整路徑的名稱為" & ActiveWorkbook.FullName
MsgBox "本工作簿對(duì)象的代碼名為" & ActiveWorkbook.CodeName
MsgBox "本工作簿的路徑為" & ActiveWorkbook.Path
If ActiveWorkbook.ReadOnly Then
MsgBox "本工作簿已經(jīng)是以只讀方式打開"
Else
MsgBox "本工作簿可讀寫."
End If
If ActiveWorkbook.Saved Then
MsgBox "本工作簿已保存."
Else
MsgBox "本工作簿需要保存."
End If
End Sub
示例03-12：訪問(wèn)工作簿的內(nèi)置屬性(BuiltinDocumentProperties屬性)
[示例03-12-01]
Sub ShowWorkbookProperties()
Dim SaveTime As String
On Error Resume Next
SaveTime = ActiveWorkbook.BuiltinDocumentProperties("Last Save Time").Value
If SaveTime = "" Then
MsgBox ActiveWorkbook.Name & "工作簿未保存."
Else
MsgBox "本工作簿已于" & SaveTime & "保存", , ActiveWorkbook.Name
End If
End Sub
示例說(shuō)明：在Excel中選擇菜單“文件——屬性”命令時(shí)將會(huì)顯示一個(gè)“屬性”對(duì)話框，該對(duì)話框中包含了當(dāng)前工作簿的有關(guān)信息，可以在VBA中使用BuiltinDocumentProperties屬性訪問(wèn)工作簿的屬性。上述示例代碼將顯示當(dāng)前工作簿保存時(shí)的日期和時(shí)間。
[示例03-12-02]
Sub listWorkbookProperties()
On Error Resume Next
'在名為"工作簿屬性"的工作表中添加信息,若該工作表不存在,則新建一個(gè)工作表
Worksheets("工作簿屬性").Activate
If Err.Number <> 0 Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "工作簿屬性"
Else
ActiveSheet.Clear
End If
On Error GoTo 0
ListProperties
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - -
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 .BuiltinDocumentProperties.Count
With .BuiltinDocumentProperties(i)
Cells(i + 1, 1) = .Name
Select Case .Type
Case msoPropertyTypeBoolean
Cells(i + 1, 2) = "Boolean"
Case msoPropertyTypeDate
Cells(i + 1, 2) = "Date"
Case msoPropertyTypeFloat
Cells(i + 1, 2) = "Float"
Case msoPropertyTypeNumber
Cells(i + 1, 2) = "Number"
Case msoPropertyTypeString
Cells(i + 1, 2) = "string"
End Select
On Error Resume Next
Cells(i + 1, 3) = .Value
On Error GoTo 0
End With
Next i
End With
Range("A:C").Columns.AutoFit
End Sub
示例說(shuō)明：本示例代碼在“工作簿屬性”工作表中列出了當(dāng)前工作簿中的所有內(nèi)置屬性。
示例03-13：測(cè)試工作簿中是否包含指定工作表(Sheets屬性)
Sub testSheetExists()
MsgBox "測(cè)試工作簿中是否存在指定名稱的工作表"
Dim b As Boolean
b = SheetExists("<指定的工作表名>")
If b = True Then
MsgBox "該工作表存在于工作簿中."
Else
MsgBox "工作簿中沒有這個(gè)工作表."
End If
End 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 = True
Else
SheetExists = False
End If
End Function
示例03-14：對(duì)未打開的工作簿進(jìn)行重命名(Name方法)
Sub rename()
Name "<工作簿路徑>\<舊名稱>.xls" As "<工作簿路徑>\<新名稱>.xls"
End Sub
示例說(shuō)明：代碼中<>中的內(nèi)容為需要重命名的工作簿所在路徑及新舊名稱。該方法只是對(duì)未打開的文件進(jìn)行重命名，如果該文件已經(jīng)打開，使用該方法會(huì)提示錯(cuò)誤。
[NextPage] 示例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等于：" & pValue
MsgBox "然后,將數(shù)值分類設(shè)置為[數(shù)值],即單元格中顯示的精度"
ActiveWorkbook.PrecisionAsDisplayed = True
pValue = ActiveCell.Value * 3
MsgBox "此時(shí),當(dāng)前單元格中的數(shù)字乘以3等于：" & pValue & "而不是1"
ActiveWorkbook.PrecisionAsDisplayed = False
End Sub
示例說(shuō)明：PrecisionAsDisplayed屬性的值設(shè)置為True，則表明采用單元格中所顯示的數(shù)值進(jìn)行計(jì)算。
示例03-16：刪除自定義數(shù)字格式(DeleteNumberFormat方法)
Sub DeleteNumberFormat()
MsgBox "從當(dāng)前工作簿中刪除000-00-0000的數(shù)字格式"
ActiveWorkbook.DeleteNumberFormat ("000-00-0000")
End Sub
示例說(shuō)明：DeleteNumberFormat方法將從指定的工作簿中刪除自定義的數(shù)字格式。
示例03-17：控制工作簿中圖形顯示(DisplatyDrawingObjects屬性)
Sub testDraw()
MsgBox "隱藏當(dāng)前工作簿中的所有圖形"
ActiveWorkbook.DisplayDrawingObjects = xlHide
MsgBox "僅顯示當(dāng)前工作簿中所有圖形的占位符"
ActiveWorkbook.DisplayDrawingObjects = xlPlaceholders
MsgBox "顯示當(dāng)前工作簿中的所有圖形"
ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
End Sub
示例說(shuō)明：本屬性作用的對(duì)象包括圖表和形狀。在應(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
示例說(shuō)明：對(duì)于Workbook對(duì)象而言，Names屬性返回的集合代表工作簿中的所有名稱。
示例03-19：檢查工作簿的自動(dòng)恢復(fù)功能(EnableAutoRecover屬性)
Sub UseAutoRecover()
'檢查是否工作簿自動(dòng)恢復(fù)功能開啟,如果沒有則開啟該功能
If ActiveWorkbook.EnableAutoRecover = False Then
ActiveWorkbook.EnableAutoRecover = True
MsgBox "剛開啟自動(dòng)恢復(fù)功能."
Else
MsgBox "自動(dòng)恢復(fù)功能已開啟."
End If
End Sub
示例03-20：設(shè)置工作簿密碼(Password屬性)
Sub UsePassword()
Dim wb As Workbook
Set wb = Application.ActiveWorkbook
wb.Password = InputBox("請(qǐng)輸入密碼:")
wb.Close
End Sub
示例說(shuō)明：Password屬性返回或設(shè)置工作簿密碼，在打開工作簿時(shí)必須輸入密碼。本示例代碼運(yùn)行后，提示設(shè)置密碼，然后關(guān)閉工作簿；再次打開工作簿時(shí)，要求輸入密碼。
示例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) = "日期和時(shí)間"
.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(Row + 1, 3).Value = "個(gè)人工作簿"
Case 2
.Cells(Row + 1, 3).Value = "共享工作簿"
End Select
Next
End With
Range("A:C").Columns.AutoFit
End Sub
示例說(shuō)明：示例代碼運(yùn)行后，將創(chuàng)建一個(gè)新工作簿并帶有用戶使用當(dāng)前工作簿的信息，即用戶名、打開的日期和時(shí)間及工作簿使用方式。
[NextPage] 示例03-22：檢查工作簿是否有密碼保護(hù)(HasPassword屬性)
Sub IsPassword()
If ActiveWorkbook.HasPassword = True Then
MsgBox "本工作簿有密碼保護(hù),請(qǐng)?jiān)诠芾韱T處獲取密碼."
Else
MsgBox "本工作簿無(wú)密碼保護(hù),您可以自由編輯."
End If
End Sub
示例03-23：決定列表邊框是否可見(InactiveListBorderVisible屬性)
Sub HideListBorders()
MsgBox "隱藏當(dāng)前工作簿中所有非活動(dòng)列表的邊框."
ActiveWorkbook.InactiveListBorderVisible = False
End Sub
示例03-24：關(guān)閉工作簿
[示例03-24-01]
Sub CloseWorkbook1()
Msgbox “不保存所作的改變而關(guān)閉本工作簿”
ActiveWorkbook.Close False
‘或ActiveWorkbook.Close SaveChanges:=False
‘或ActiveWorkbook.Saved=True
End sub
[示例03-24-02]
Sub CloseWorkbook2()
Msgbox “保存所作的改變并關(guān)閉本工作簿”
ActiveWorkbook.Close True
End sub
[示例03-24-03]
Sub CloseWorkbook3()
Msgbox “關(guān)閉本工作簿。如果工作簿已發(fā)生變化，則彈出是否保存更改的對(duì)話框?！?br>ActiveWorkbook.Close True
End sub
[示例03-24-04] 關(guān)閉并保存所有工作簿
Sub CloseAllWorkbooks()
Dim Book As Workbook
For Each Book In Workbooks
If Book.Name<>ThisWorkbook.Name Then
Book.Close savechanges:=True
End If
Next Book
ThisWorkbook.Close savechanges:=True
End Sub
[示例03-24-05] 關(guān)閉工作簿并將它徹底刪除
Sub KillMe()
With ThisWorkbook
.Saved = True
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close False
End With
End Sub
[示例03-24-06]關(guān)閉所有工作簿，若工作簿已改變則彈出是否保存變化的對(duì)話框
Sub closeAllWorkbook()
MsgBox "關(guān)閉當(dāng)前所打開的所有工作簿"
Workbooks.Close
End Sub
<其它一些有關(guān)操作工作簿的示例>
示例03-25：創(chuàng)建新的工作簿
Sub testNewWorkbook()
MsgBox "創(chuàng)建一個(gè)帶有10個(gè)工作表的新工作簿"
Dim wb as Workbook
Set wb = NewWorkbook(10)
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - -
Function NewWorkbook(wsCount As Integer) As Workbook
'創(chuàng)建帶有由變量wsCount提定數(shù)量工作表的工作簿，工作表數(shù)在1至255之間
Dim OriginalWorksheetCount As Long
Set NewWorkbook = Nothing
If wsCount < 1 Or wsCount > 255 Then Exit Function
OriginalWorksheetCount = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = wsCount
Set NewWorkbook = Workbooks.Add
Application.SheetsInNewWorkbook = OriginalWorksheetCount
End Function
示例說(shuō)明：自定義函數(shù)NewWorkbook可以創(chuàng)建最多帶有255個(gè)工作表的工作簿。本測(cè)試示例創(chuàng)建一個(gè)帶有10個(gè)工作表的新工作簿。
示例03-26：判斷工作簿是否存在
Sub testFileExists()
MsgBox "如果文件不存在則用信息框說(shuō)明,否則打開該文件."
If Not FileExists("C:\文件夾\子文件夾\文件.xls") Then
MsgBox "這個(gè)工作簿不存在!"
Else
Workbooks.Open "C:\文件夾\子文件夾\文件.xls"
End If
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - -
Function FileExists(FullFileName As String) As Boolean
'如果工作簿存在,則返回True
FileExists = Len(Dir(FullFileName)) > 0
End Function
示例說(shuō)明：本示例使用自定義函數(shù)FileExists判斷工作簿是否存在，若該工作簿已存在，則打開它。代碼中，“C:\文件夾\子文件夾\文件.xls”代表工作簿所在的文件夾名、子文件夾名和工作簿文件名。
示例03-27：判斷工作簿是否已打開
[示例03-27-01]
Sub testWorkbookOpen()
MsgBox "如果工作簿未打開,則打開該工作簿."
If Not WorkbookOpen("工作簿名.xls") Then
Workbooks.Open "工作簿名.xls"
End If
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - -
Function WorkbookOpen(WorkBookName As String) As Boolean
'如果該工作簿已打開則返回真
WorkbookOpen = False
On Error GoTo WorkBookNotOpen
If Len(Application.Workbooks(WorkBookName).Name) > 0 Then
WorkbookOpen = True
MsgBox "該工作簿已打開"
Exit Function
End If
WorkBookNotOpen:
End Function
示例說(shuō)明：本示例中的函數(shù)WorkbookOpen用來(lái)判斷工作簿是否打開。代碼中，“工作簿名.xls”代表所要打開的工作簿名稱。
[示例03-27-02]
Sub testWookbookIFOpen()
Dim wb As String
Dim bwb As Boolean
wb = "<要判斷的工作簿名稱>"
bwb = WorkbookIsOpen(wb)
If bwb = True Then
MsgBox "工作簿" & wb & "已打開."
Else
MsgBox "工作簿" & wb & "未打開."
End If
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - -
Private Function WorkbookIsOpen(wbname) As Boolean
Dim x As Workbook
On Error Resume Next
Set x = Workbooks(wbname)
If Err = 0 Then
WorkbookIsOpen = True
Else
WorkbookIsOpen = False
End If
End Function
示例03-28：備份工作簿
[示例03-28-01] 用與活動(dòng)工作簿相同的名字但后綴名為.bak備份工作簿
Sub SaveWorkbookBackup()
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
BackupFileName = awb.FullName
i = 0
While InStr(i + 1, BackupFileName, ".") > 0
i = InStr(i + 1, BackupFileName, ".")
Wend
If i > 0 Then BackupFileName = Left(BackupFileName, i - 1)
BackupFileName = BackupFileName & ".bak"
OK = False
On Error GoTo NotAbleToSave
With awb
Application.StatusBar = "正在保存工作簿..."
.Save
Application.StatusBar = "正在備份工作簿..."
.SaveCopyAs BackupFileName
OK = True
End With
End If
NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False
If Not OK Then
MsgBox "備份工作簿未保存!", vbExclamation, ThisWorkbook.Name
End If
End Sub
示例說(shuō)明：在當(dāng)前工作簿中運(yùn)行本示例代碼后，將以與工作簿相同的名稱但后綴名為.bak備份工作簿，且該備份與當(dāng)前工作簿在同一文件夾中。其中，使用了工作簿的FullName屬性和SaveCopyAs方法。
[示例03-28-02] 保存當(dāng)前工作簿的副本到其它位置備份工作簿
Sub SaveWorkbookBackupToFloppyD()
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
BackupFileName = awb.Name
OK = False
On Error GoTo NotAbleToSave
If Dir("D:\" & BackupFileName) <> "" Then
Kill "D:\" & BackupFileName
End If
With awb
Application.StatusBar = "正在保存工作簿..."
.Save
Application.StatusBar = "正在備份工作簿..."
.SaveCopyAs "D:\" & BackupFileName
OK = True
End With
End If
NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False
If Not OK Then
MsgBox "備份工作簿未保存!", vbExclamation, ThisWorkbook.Name
End If
End Sub
示例說(shuō)明：本程序?qū)旬?dāng)前工作簿進(jìn)行復(fù)制并以與當(dāng)前工作簿相同的名稱保存在D盤中。其中，使用了Kill方法來(lái)刪除已存在的工作簿。
示例03-29：從已關(guān)閉的工作簿中取值
[示例03-29-01]
Sub testGetValuesFromClosedWorkbook()
GetValuesFromAClosedWorkbook "C:", "Book1.xls", "Sheet1", "A1:G20"
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - -
Sub GetValuesFromAClosedWorkbook(fPath As String, _
fName As String, sName, cellRange As String)
With ActiveSheet.Range(cellRange)
.FormulaArray = "='" & fPath & "\[" & fName & "]" _
& sName & "'!" & cellRange
.Value = .Value
End With
End Sub
示例說(shuō)明：本示例包含一個(gè)子過(guò)程GetValuesFromAClosedWorkbook，用來(lái)從已關(guān)閉的工作簿中獲取數(shù)據(jù)，主過(guò)程testGetValuesFromClosedWorkbook用來(lái)傳遞參數(shù)。本示例表示從C盤根目錄下的Book1.xls工作簿的工作表Sheet1中的A1:G20單元格區(qū)域內(nèi)獲取數(shù)據(jù)，并將其復(fù)制到當(dāng)前工作表相應(yīng)單元格區(qū)域中。
[示例03-29-02]
Sub ReadDataFromAllWorkbooksInFolder()
Dim FolderName As String, wbName As String, r As Long, cValue As Variant
Dim wbList() As String, wbCount As Integer, i As Integer
FolderName = "C:\文件夾名"
'創(chuàng)建文件夾中工作簿列表
wbCount = 0
wbName = Dir(FolderName & "\" & "*.xls")
While wbName <> ""
wbCount = wbCount + 1
ReDim Preserve wbList(1 To wbCount)
wbList(wbCount) = wbName
wbName = Dir
Wend
If wbCount = 0 Then Exit Sub
'從每個(gè)工作簿中獲取數(shù)據(jù)
r = 0
Workbooks.Add
For i = 1 To wbCount
r = r + 1
cValue = GetInfoFromClosedFile(FolderName, wbList(i), "Sheet1", "A1")
Cells(r, 1).Formula = wbList(i)
Cells(r, 2).Formula = cValue
Next i
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - -
Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = ""
If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
If Dir(wbPath & "\" & wbName) = "" Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function
示例說(shuō)明：本示例將讀取一個(gè)文件夾內(nèi)所有工作簿中工作表Sheet1上單元格A1中的值到一個(gè)新工作簿中。代碼中，“C:\文件夾名”代表工作簿所在的文件夾名。
[示例03-29-03]
Sub GetDataFromClosedWorkbook()
Dim wb As Workbook
Application.ScreenUpdating = False
'以只讀方式打開工作簿
Set wb = Workbooks.Open("C:\文件夾名\文件.xls", True, True)
With ThisWorkbook.Worksheets("工作表名")
'從工作簿中讀取數(shù)據(jù)
.Range("A10").Formula = wb.Worksheets("源工作表名").Range("A10").Formula
.Range("A11").Formula = wb.Worksheets("源工作表名").Range("A20").Formula
.Range("A12").Formula = wb.Worksheets("源工作表名").Range("A30").Formula
.Range("A13").Formula = wb.Worksheets("源工作表名").Range("A40").Formula
End With
wb.Close False '關(guān)閉打開的源數(shù)據(jù)工作簿且不保存任何變化
Set wb = Nothing '釋放內(nèi)存
Application.ScreenUpdating = True
End Sub
示例說(shuō)明：在運(yùn)行程序時(shí)，打開所要獲取數(shù)據(jù)的工作簿，當(dāng)取得數(shù)據(jù)后再關(guān)閉該工作簿。將屏幕更新屬性值設(shè)置為False，將看不出源數(shù)據(jù)工作簿是否被打開過(guò)。本程序代碼中，“C:\文件夾名\文件.xls”、"源工作表名"代表工作簿所在的文件夾和工作簿文件名。
本站僅提供存儲(chǔ)服務(wù)，所有內(nèi)容均由用戶發(fā)布，如發(fā)現(xiàn)有害或侵權(quán)內(nèi)容，請(qǐng)
點(diǎn)擊舉報(bào)。
