VBA Application,window,worksheet基本操作方法(三)
工作簿(Workbook)基本操作應用示例
Workbook對象代表工作簿，而Workbooks集合則包含了當前所有的工作簿。下面對Workbook對象的重要的方法和屬性以及其它一些可能涉及到的方法和屬性進行示例介紹，同時，後面的示例也深入介紹了一些工作簿對象操作的方法和技巧。
--------------------------------------------------------------------------------
示例03-01：創建工作簿(Add方法)
[示例03-01-01]
Sub CreateNewWorkbook1()
MsgBox "將創建一個新工作簿."
Workbooks.Add
End Sub
[示例03-01-02]
Sub CreateNewWorkbook2()
Dim wb As Workbook
Dim ws As Worksheet
Dim i As Long
MsgBox "將創建一個新工作簿,並預設工作表格式."
Set wb = Workbooks.Add
Set ws = wb.Sheets(1)
ws.Name = "產品彙總表"
ws.Cells(1, 1) = "序號"
ws.Cells(1, 2) = "產品名稱"
ws.Cells(1, 3) = "產品數量"
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
示例說明：本示例使用了Add方法和SaveAs方法，添加一個新工作簿並將該工作簿以文件名SalesData.xls保存在D盤中。其中，語句Application.DisplayAlerts = False表示禁止彈出警告對話框。
--------------------------------------------------------------------------------
示例03-03：打開工作簿(Open方法)
[示例03-03-01]
Sub openWorkbook1()
Workbooks.Open "<需打開文件的路徑>\<文件名>"
End Sub
示例說明：代碼中的<>裏的內容需用所需打開的文件的路徑及文件名代替。Open方法共有15個參數，其中參數FileName爲必需的參數，其餘參數可選。
[示例03-03-02]
Sub openWorkbook2()
Dim fname As String
MsgBox "將D盤中的<測試.xls>工作簿以只讀方式打開"
fname = "D:\測試.xls"
Workbooks.Open Filename:=fname, ReadOnly:=True
End Sub
--------------------------------------------------------------------------------
示例03-04：將文本文件導入工作簿中(OpenText方法)
Sub TextToWorkbook()
'本示例打開某文本文件並將製表符作爲分隔符對此文件進行分列處理轉換成爲工作表
Workbooks.OpenText Filename:="<文本文件所在的路徑>/<文本文件名>", _
DataType:=xlDelimited, Tab:=True
End Sub
示例說明：代碼中的<>裏的內容需用所載入的文本文件所在路徑及文件名代替。OpenText方法的作用是導入一個文本文件，並將其作爲包含單個工作表的工作簿進行分列處理，然後在此工作表中放入經過分列處理的文本文件數據。該方法共有18個參數，其中參數FileName爲必需的參數，其餘參數可選。
--------------------------------------------------------------------------------
示例03-05：保存工作簿(Save方法)
[示例03-05-01]
Sub SaveWorkbook()
MsgBox "保存當前工作簿."
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
示例說明：本示例保存原來已存在且已打開的工作簿。
--------------------------------------------------------------------------------
示例03-06：保存工作簿(SaveAs方法)
[示例03-06-01]
Sub SaveWorkbook1()
MsgBox "將工作簿以指定名保存在默認文件夾中."
ActiveWorkbook.SaveAs "<工作簿名>.xls"
End Sub
示例說明：SaveAs方法相當於“另存爲……”命令，以指定名稱保存工作簿。該方法有12個參數，均爲可選參數。如果未指定保存的路徑，那麼將在默認文件夾中保存該工作簿。如果文件夾中該工作簿名已存在，則提示是否替換原工作簿。
[示例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
示例說明：本示例將當前工作簿以一個新名(即new加原名)保存在默認文件夾中。
[示例03-06-03]
Sub CreateBak1()
MsgBox "保存工作簿並建立備份工作簿"
ActiveWorkbook.SaveAs CreateBackup:=True
End Sub
示例說明：本示例將在當前文件夾中建立工作簿的備份。
[示例03-06-04]
Sub CreateBak2()
MsgBox "保存工作簿時,若已建立了備份,則將出現包含True的信息框,否則出現False."
MsgBox ActiveWorkbook.CreateBackup
End Sub
--------------------------------------------------------------------------------
示例03-07：取得當前打開的工作簿數(Count屬性)
Sub WorkbookNum()
MsgBox "當前已打開的工作簿數爲:" & Chr(10) & Workbooks.Count
End Sub
--------------------------------------------------------------------------------
[NextPage] 示例03-08：激活工作簿(Activate方法)
[示例03-08-01]
Sub ActivateWorkbook1()
Workbooks("<工作簿名>").Activate
End Sub
示例說明：Activate方法激活一個工作簿，使該工作簿爲當前工作簿。
[示例03-08-02]
Sub ActivateWorkbook2()
Dim n As Long, i As Long
Dim b As String
MsgBox "依次激活已經打開的工作簿"
n = Workbooks.Count
For i = 1 To n
Workbooks(i).Activate
b = MsgBox("第 " & i & "個工作簿被激活，還要繼續嗎?", vbYesNo)
If b = vbNo Then Exit Sub
If i = n Then MsgBox "最後一個工作簿已被激活."
Next i
End Sub
--------------------------------------------------------------------------------
示例03-09：保護工作簿(Protect方法)
Sub ProtectWorkbook()
MsgBox "保護工作簿結構,密碼爲123"
ActiveWorkbook.Protect Password:="123", Structure:=True
MsgBox "保護工作簿窗口,密碼爲123"
ActiveWorkbook.Protect Password:="123", Windows:=True
MsgBox "保護工作簿結構和窗口,密碼爲123"
ActiveWorkbook.Protect Password:="123", Structure:=True, Windows:=True
End Sub
示例說明：使用Protect方法來保護工作簿，帶有三個可選參數，參數Password指明保護工作簿密碼，要解除工作簿保護應輸入此密碼；參數Structure設置爲True則保護工作簿結構，此時不能對工作簿中的工作表進行插入、複製、刪除等操作；參數Windows設置爲True則保護工作簿窗口，此時該工作簿右上角的最小化、最大化和關閉按鈕消失。
--------------------------------------------------------------------------------
示例03-10：解除工作簿保護(UnProtect方法)
Sub UnprotectWorkbook()
MsgBox "取消工作簿保護"
ActiveWorkbook.Unprotect "123"
End Sub
--------------------------------------------------------------------------------
示例03-11：工作簿的一些通用屬性示例
Sub testGeneralWorkbookInfo()
MsgBox "本工作簿的名稱爲" & ActiveWorkbook.Name
MsgBox "本工作簿帶完整路徑的名稱爲" & ActiveWorkbook.FullName
MsgBox "本工作簿對象的代碼名爲" & ActiveWorkbook.CodeName
MsgBox "本工作簿的路徑爲" & ActiveWorkbook.Path
If ActiveWorkbook.ReadOnly Then
MsgBox "本工作簿已經是以只讀方式打開"
Else
MsgBox "本工作簿可讀寫."
End If
If ActiveWorkbook.Saved Then
MsgBox "本工作簿已保存."
Else
MsgBox "本工作簿需要保存."
End If
End Sub
--------------------------------------------------------------------------------
示例03-12：訪問工作簿的內置屬性(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
示例說明：在Excel中選擇菜單“文件——屬性”命令時將會顯示一個“屬性”對話框，該對話框中包含了當前工作簿的有關信息，可以在VBA中使用BuiltinDocumentProperties屬性訪問工作簿的屬性。上述示例代碼將顯示當前工作簿保存時的日期和時間。
[示例03-12-02]
Sub listWorkbookProperties()
On Error Resume Next
'在名爲"工作簿屬性"的工作表中添加信息,若該工作表不存在,則新建一個工作表
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
示例說明：本示例代碼在“工作簿屬性”工作表中列出了當前工作簿中的所有內置屬性。
--------------------------------------------------------------------------------
示例03-13：測試工作簿中是否包含指定工作表(Sheets屬性)
Sub testSheetExists()
MsgBox "測試工作簿中是否存在指定名稱的工作表"
Dim b As Boolean
b = SheetExists("<指定的工作表名>")
If b = True Then
MsgBox "該工作表存在於工作簿中."
Else
MsgBox "工作簿中沒有這個工作表."
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：對未打開的工作簿進行重命名(Name方法)
Sub rename()
Name "<工作簿路徑>\<舊名稱>.xls" As "<工作簿路徑>\<新名稱>.xls"
End Sub
示例說明：代碼中<>中的內容爲需要重命名的工作簿所在路徑及新舊名稱。該方法只是對未打開的文件進行重命名，如果該文件已經打開，使用該方法會提示錯誤。
--------------------------------------------------------------------------------
[NextPage] 示例03-15：設置數字精度(PrecisionAsDisplayed屬性)
Sub SetPrecision()
Dim pValue
MsgBox "在當前單元格中輸入1/3，並將結果算至小數點後兩位"
ActiveCell.Value = 1 / 3
ActiveCell.NumberFormatLocal = "0.00"
pValue = ActiveCell.Value * 3
MsgBox "當前單元格中的數字乘以3等於：" & pValue
MsgBox "然後,將數值分類設置爲[數值],即單元格中顯示的精度"
ActiveWorkbook.PrecisionAsDisplayed = True
pValue = ActiveCell.Value * 3
MsgBox "此時,當前單元格中的數字乘以3等於：" & pValue & "而不是1"
ActiveWorkbook.PrecisionAsDisplayed = False
End Sub
示例說明：PrecisionAsDisplayed屬性的值設置爲True，則表明採用單元格中所顯示的數值進行計算。
--------------------------------------------------------------------------------
示例03-16：刪除自定義數字格式(DeleteNumberFormat方法)
Sub DeleteNumberFormat()
MsgBox "從當前工作簿中刪除000-00-0000的數字格式"
ActiveWorkbook.DeleteNumberFormat ("000-00-0000")
End Sub
示例說明：DeleteNumberFormat方法將從指定的工作簿中刪除自定義的數字格式。
--------------------------------------------------------------------------------
示例03-17：控制工作簿中圖形顯示(DisplatyDrawingObjects屬性)
Sub testDraw()
MsgBox "隱藏當前工作簿中的所有圖形"
ActiveWorkbook.DisplayDrawingObjects = xlHide
MsgBox "僅顯示當前工作簿中所有圖形的佔位符"
ActiveWorkbook.DisplayDrawingObjects = xlPlaceholders
MsgBox "顯示當前工作簿中的所有圖形"
ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
End Sub
示例說明：本屬性作用的對象包括圖表和形狀。在應用本示例前，應保證工作簿中有圖表或形狀，以察看效果。
--------------------------------------------------------------------------------
示例03-18：指定名稱(Names屬性)
Sub testNames()
MsgBox "將當前工作簿中工作表Sheet1內單元格A1命名爲myName."
ActiveWorkbook.Names.Add Name:="myName", RefersToR1C1:="=Sheet1!R1C1"
End Sub
示例說明：對於Workbook對象而言，Names屬性返回的集合代表工作簿中的所有名稱。
--------------------------------------------------------------------------------
示例03-19：檢查工作簿的自動恢復功能(EnableAutoRecover屬性)
Sub UseAutoRecover()
'檢查是否工作簿自動恢復功能開啓,如果沒有則開啓該功能
If ActiveWorkbook.EnableAutoRecover = False Then
ActiveWorkbook.EnableAutoRecover = True
MsgBox "剛開啓自動恢復功能."
Else
MsgBox "自動恢復功能已開啓."
End If
End Sub
--------------------------------------------------------------------------------
示例03-20：設置工作簿密碼(Password屬性)
Sub UsePassword()
Dim wb As Workbook
Set wb = Application.ActiveWorkbook
wb.Password = InputBox("請輸入密碼:")
wb.Close
End Sub
示例說明：Password屬性返回或設置工作簿密碼，在打開工作簿時必須輸入密碼。本示例代碼運行後，提示設置密碼，然後關閉工作簿；再次打開工作簿時，要求輸入密碼。
--------------------------------------------------------------------------------
示例03-21：返回工作簿用戶狀態信息(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) = "日期和時間"
.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 = "個人工作簿"
Case 2
.Cells(Row + 1, 3).Value = "共享工作簿"
End Select
Next
End With
Range("A:C").Columns.AutoFit
End Sub
示例說明：示例代碼運行後，將創建一個新工作簿並帶有用戶使用當前工作簿的信息，即用戶名、打開的日期和時間及工作簿使用方式。
--------------------------------------------------------------------------------
[NextPage] 示例03-22：檢查工作簿是否有密碼保護(HasPassword屬性)
Sub IsPassword()
If ActiveWorkbook.HasPassword = True Then
MsgBox "本工作簿有密碼保護,請在管理員處獲取密碼."
Else
MsgBox "本工作簿無密碼保護,您可以自由編輯."
End If
End Sub
--------------------------------------------------------------------------------
示例03-23：決定列表邊框是否可見(InactiveListBorderVisible屬性)
Sub HideListBorders()
MsgBox "隱藏當前工作簿中所有非活動列表的邊框."
ActiveWorkbook.InactiveListBorderVisible = False
End Sub
--------------------------------------------------------------------------------
示例03-24：關閉工作簿
[示例03-24-01]
Sub CloseWorkbook1()
Msgbox “不保存所作的改變而關閉本工作簿”
ActiveWorkbook.Close False
‘或ActiveWorkbook.Close SaveChanges:=False
‘或ActiveWorkbook.Saved=True
End sub
[示例03-24-02]
Sub CloseWorkbook2()
Msgbox “保存所作的改變並關閉本工作簿”
ActiveWorkbook.Close True
End sub
[示例03-24-03]
Sub CloseWorkbook3()
Msgbox “關閉本工作簿。如果工作簿已發生變化，則彈出是否保存更改的對話框。”
ActiveWorkbook.Close True
End sub
[示例03-24-04] 關閉並保存所有工作簿
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] 關閉工作簿並將它徹底刪除
Sub KillMe()
With ThisWorkbook
.Saved = True
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close False
End With
End Sub
[示例03-24-06]關閉所有工作簿，若工作簿已改變則彈出是否保存變化的對話框
Sub closeAllWorkbook()
MsgBox "關閉當前所打開的所有工作簿"
Workbooks.Close
End Sub
<其它一些有關操作工作簿的示例>
示例03-25：創建新的工作簿
Sub testNewWorkbook()
MsgBox "創建一個帶有10個工作表的新工作簿"
Dim wb as Workbook
Set wb = NewWorkbook(10)
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - -
Function NewWorkbook(wsCount As Integer) As Workbook
'創建帶有由變量wsCount提定數量工作表的工作簿，工作表數在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
示例說明：自定義函數NewWorkbook可以創建最多帶有255個工作表的工作簿。本測試示例創建一個帶有10個工作表的新工作簿。
--------------------------------------------------------------------------------
示例03-26：判斷工作簿是否存在
Sub testFileExists()
MsgBox "如果文件不存在則用信息框說明,否則打開該文件."
If Not FileExists("C:\文件夾\子文件夾\文件.xls") Then
MsgBox "這個工作簿不存在!"
Else
Workbooks.Open "C:\文件夾\子文件夾\文件.xls"
End If
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - -
Function FileExists(FullFileName As String) As Boolean
'如果工作簿存在,則返回True
FileExists = Len(Dir(FullFileName)) > 0
End Function
示例說明：本示例使用自定義函數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
示例說明：本示例中的函數WorkbookOpen用來判斷工作簿是否打開。代碼中，“工作簿名.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] 用與活動工作簿相同的名字但後綴名爲.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
示例說明：在當前工作簿中運行本示例代碼後，將以與工作簿相同的名稱但後綴名爲.bak備份工作簿，且該備份與當前工作簿在同一文件夾中。其中，使用了工作簿的FullName屬性和SaveCopyAs方法。
[示例03-28-02] 保存當前工作簿的副本到其它位置備份工作簿
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
示例說明：本程序將把當前工作簿進行復制並以與當前工作簿相同的名稱保存在D盤中。其中，使用了Kill方法來刪除已存在的工作簿。
--------------------------------------------------------------------------------
示例03-29：從已關閉的工作簿中取值
[示例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
示例說明：本示例包含一個子過程GetValuesFromAClosedWorkbook，用來從已關閉的工作簿中獲取數據，主過程testGetValuesFromClosedWorkbook用來傳遞參數。本示例表示從C盤根目錄下的Book1.xls工作簿的工作表Sheet1中的A1:G20單元格區域內獲取數據，並將其複製到當前工作表相應單元格區域中。
[示例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:\文件夾名"
'創建文件夾中工作簿列表
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
'從每個工作簿中獲取數據
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
示例說明：本示例將讀取一個文件夾內所有工作簿中工作表Sheet1上單元格A1中的值到一個新工作簿中。代碼中，“C:\文件夾名”代表工作簿所在的文件夾名。
[示例03-29-03]
Sub GetDataFromClosedWorkbook()
Dim wb As Workbook
Application.ScreenUpdating = False
'以只讀方式打開工作簿
Set wb = Workbooks.Open("C:\文件夾名\文件.xls", True, True)
With ThisWorkbook.Worksheets("工作表名")
'從工作簿中讀取數據
.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 '關閉打開的源數據工作簿且不保存任何變化
Set wb = Nothing '釋放內存
Application.ScreenUpdating = True
End Sub
示例說明：在運行程序時，打開所要獲取數據的工作簿，當取得數據後再關閉該工作簿。將屏幕更新屬性值設置爲False，將看不出源數據工作簿是否被打開過。本程序代碼中，“C:\文件夾名\文件.xls”、"源工作表名"代表工作簿所在的文件夾和工作簿文件名。
--------------------------------------------------------------------------------
工作表名稱的使用
可以在代碼中採用下面的三種方式引用工作表：
(1) 該工作表在工作簿中的位置(索引號)。索引號自工作表標籤最左邊向右依次計數，最左邊的是第1個工作表，依次爲第2個、3個……等等。
(2) 該工作表的名稱，即在工作表左下角中看到的工作表標籤中的名稱。
(3) 該工作表的對象名稱，即在創建工作表時自動分配給該工作表的名稱(在VBE編輯器中的工程窗口中可以看到)。
通常，在代碼中引用工作表時，我們所使用的是工作表對象的Index屬性和Name屬性，例如 Worksheets(1).Select或者Worksheets(“Sheet1”).Select。
但是，如果工作表的名稱被改變或者工作表被重新排序或者刪除其中的一些工作表後，則不能使用工作表對象的Name屬性或Index屬性引用所需要的工作表，這可能使已經編寫好的代碼出現錯誤。因此，我們應該考慮雖然工作簿中的工作表改變但不影響工作表引用的辦法，可以使用工作表對象的名稱避免這種情況，即上面所講的第3種方式，無論是在工作簿中增加或刪除其它工作表，還是對工作表排序，或者是重命名需要引用的該工作表，其對象名都不變(除非您刪除該工作表，或者是在VBE窗口中重命名該對象)。工作表對象的名稱可以在VBE編程器中看到，如下圖2所示。例如，Sheet1(Sheet1)，左邊是工作表對象的名稱，右邊的括號中是工作表名，括號中的工作表名可以通過在工作簿界面中改變相應的工作表標籤名來改變，如果在工作表中重命名Sheet1工作表爲“數據工作表”，則工程屬性窗口中的名稱爲：Sheet1(數據工作表)。在下圖2中，工作表Sheet3的對象名稱是“主工作表”，而在Excel中，如果改變工作表Sheet3的名稱爲“數據工作表”，在VBE編程器的工程窗口中，“Sheet3”將變成“數據工作表”，但是該工作表的對象名稱仍爲“主工作表”，如下圖3所示。
圖2 圖3
改變工作表對象名稱的方法是，通過改變屬性窗口中的(名稱)或者在代碼中使用Properties("_CodeName")。下面的代碼將會添加一個工作表並將該工作表的對象名稱命名爲"ws_main"，這樣，在以後的代碼中就可以使用該對象名稱來引用這個工作表，而不必擔心工作表名稱改變或工作表順序改變。
Sub ChageWksObjectName()
Dim ws As Worksheet
Dim sPrevCodeName As String
Dim sNewCodeName As String
'設置新對象的名稱
sNewCodeName = "ws_main"
'增加新工作表
Set ws = Worksheets.Add
'獲取新增工作表的對象名稱
sPrevCodeName = ws.CodeName
'變化新增工作表的對象名稱
ThisWorkbook.VBProject.VBComponents(sPrevCodeName). _
Properties("_CodeName") = sNewCodeName
End Sub
‘- - - - - - - - - - - - - - - - - - - - - -
Sub Test()
ws_main.Range("A1").Value = "This is it!"
End Sub
下面的示例簡單的介紹了工作表的引用方法。在示例中，使用了工作表Sheet1。
(1) 指定工作表的位置激活工作表。下面的代碼激活工作簿中的第1個工作表，即工作表標籤最左邊的工作表。(如果增加或刪除了其中某工作表，或者是對工作表進行排序後，可能引用的不是您想引用的工作表)
Sub ActivateFirstsheetInBook()
Sheets(1).Activate
End Sub
或者：
Sub ReferenceShtByIndexNumber()
Sheets(1).[A1:D4].Copy Sheets(2).[A1]
End Sub
(2) 通過工作表的名稱激活工作表，而不管工作表處於工作簿中的什麼位置以及工作表對象的代碼名稱。(如果該工作表被重命名後，運行代碼會出錯)
Sub ActivateSheet1_1()
Sheets("Sheet1").Activate
End Sub
或者：
Sub ReferenceShtByGivenName()
[Sheet1!A1:D4].Copy [Sheet2!A1]
End Sub
(3) 通過工作表對象的名稱激活工作表，而不管該工作表處於工作簿中的什麼位置以及該工作表的名稱）
Sub ActivateSheet1_2()
Sheet1.Activate
End Sub
或者：
Sub ReferenceShtByCodeName()
Sheet1.[A1:D4].Copy Sheet2.[A1]
End Sub
工作表(Worksheet)基本操作應用示例
[示例04-01]增加工作表(Add方法)
Sub AddWorksheet()
MsgBox "在當前工作簿中添加一個工作表"
Worksheets.Add
MsgBox "在當前工作簿中的工作表sheet2之前添加一個工作表"
Worksheets.Add before:=Worksheets("sheet2")
MsgBox "在當前工作簿中的工作表sheet2之後添加一個工作表"
Worksheets.Add after:=Worksheets("sheet2")
MsgBox "在當前工作簿中添加3個工作表"
Worksheets.Add Count:=3
End Sub
示例說明：Add方法帶有4個可選的參數，其中參數Before和參數After指定所增加的工作表的位置，但兩個參數只能選一；參數Count用來指定增加的工作表數目。
--------------------------------------------------------------------------------
[示例04-02]複製工作表(Copy方法)
Sub CopyWorksheet()
MsgBox "在當前工作簿中複製工作表sheet1並將所複製的工作表放在工作表sheet2之前"
Worksheets("sheet1").Copy Before:=Worksheets("sheet2")
MsgBox "在當前工作簿中複製工作表sheet2並將所複製的工作表放在工作表sheet3之後"
Worksheets("sheet2").Copy After:=Worksheets("sheet3")
End Sub
示例說明：Copy方法帶有2個可選的參數，即參數Before和參數After，在使用時兩個參數只參選一。
--------------------------------------------------------------------------------
[示例04-03]移動工作表(Move方法)
Sub MoveWorksheet()
MsgBox "在當前工作簿中將工作表sheet3移至工作表sheet2之前"
Worksheets("sheet3").Move Before:=Worksheets("sheet2")
MsgBox "在當前工作簿中將工作表sheet1移至最後"
Worksheets("sheet1").Move After:=Worksheets(Worksheets.Count)
End Sub
示例說明：Move方法與Copy方法的參數相同，作用也一樣。
--------------------------------------------------------------------------------
[示例04-04]隱藏和顯示工作表(Visible屬性)
[示例04-04-01]
Sub testHide()
MsgBox "第一次隱藏工作表sheet1"
Worksheets("sheet1").Visible = False
MsgBox "顯示工作表sheet1"
Worksheets("sheet1").Visible = True
MsgBox "第二次隱藏工作表sheet1"
Worksheets("sheet1").Visible = xlSheetHidden
MsgBox "顯示工作表sheet1"
Worksheets("sheet1").Visible = True
MsgBox "第三次隱藏工作表sheet1"
Worksheets("sheet1").Visible = xlSheetHidden
MsgBox "顯示工作表sheet1"
Worksheets("sheet1").Visible = xlSheetVisible
MsgBox "第四隱藏工作表sheet1"
Worksheets("sheet1").Visible = xlSheetVeryHidden
MsgBox "顯示工作表sheet1"
Worksheets("sheet1").Visible = True
MsgBox "第五隱藏工作表sheet1"
Worksheets("sheet1").Visible = xlSheetVeryHidden
MsgBox "顯示工作表sheet1"
Worksheets("sheet1").Visible = xlSheetVisible
End Sub
示例說明：本示例演示了隱藏和顯示工作表的各種情形。其中，使用xlSheetVeryHidden常量來隱藏工作表，將不能通過選擇工作表菜單欄中的“格式”——“工作表”——“取消隱藏”命令來取消隱藏。
--------------------------------------------------------------------------------
[示例04-04-02]
Sub ShowAllSheets()
MsgBox "使當前工作簿中的所有工作表都顯示(即將隱藏的工作表也顯示)"
Dim ws As Worksheet
For Each ws In Sheets
ws.Visible = True
Next ws
End Sub
--------------------------------------------------------------------------------
[示例04-05]獲取工作表數(Count屬性)
[示例04-05-01]
Sub WorksheetNum()
Dim i As Long
i = Worksheets.Count
MsgBox "當前工作簿的工作表數爲：" & Chr(10) & i
End Sub
--------------------------------------------------------------------------------
[示例04-05-02]
Sub WorksheetNum()
Dim i As Long
i = Sheets.Count
MsgBox "當前工作簿的工作表數爲：" & Chr(10) & i
End Sub
示例說明：在一個包含圖表工作表的工作簿中運行上述兩段代碼，將會得出不同的結果，原因是對於Sheets集合來講，工作表包含圖表工作表。應注意Worksheets集合與Sheets集合的區別，下同。
--------------------------------------------------------------------------------
[示例04-06]獲取或設置工作表名稱(Name屬性)
[示例04-06-01]
Sub NameWorksheet()
Dim sName As String, sChangeName As String
sName = Worksheets(2).Name
MsgBox "當前工作簿中第2個工作表的名字爲：" & sName
sChangeName = "我的工作表"
MsgBox "將當前工作簿中的第3個工作表名改爲：" & sChangeName
Worksheets(3).Name = sChangeName
End Sub
示例說明：使用Name屬性可以獲取指定工作表的名稱，也可以設置工作表的名稱。
--------------------------------------------------------------------------------
[示例04-06-02]重命名工作表
Sub ReNameSheet()
Dim xStr As String
Retry:
Err.Clear
xStr = InputBox("請輸入工作表的新名稱:" _
, "重命名工作表", ActiveSheet.Name)
If xStr = "" Then Exit Sub
On Error Resume Next
ActiveSheet.Name = xStr
If Err.Number <> 0 Then
MsgBox Err.Number & " " & Err.Description
Err.Clear
GoTo Retry
End If
On Error GoTo 0
'.........
End Sub
--------------------------------------------------------------------------------
[NextPage][示例04-07]激活/選擇工作表(Activate方法和Select方法)
[示例04-07-01]
Sub SelectWorksheet()
MsgBox "激活當前工作簿中的工作表sheet2"
Worksheets("sheet2").Activate
MsgBox "激活當前工作簿中的工作表sheet3"
Worksheets("sheet3").Select
MsgBox "同時選擇工作簿中的工作表sheet2和sheet3"
Worksheets(Array("sheet2", "sheet3")).Select
End Sub
示例說明：Activate方法只能激活一個工作表，而Select方法可以同時選擇多個工作表。
--------------------------------------------------------------------------------
[示例04-07-02]
Sub SelectManySheet()
MsgBox "選取第一個和第三個工作表."
Worksheets(1).Select
Worksheets(3).Select False
End Sub
--------------------------------------------------------------------------------
[示例04-08]獲取當前工作表的索引號(Index屬性)
Sub GetSheetIndex()
Dim i As Long
i = ActiveSheet.Index
MsgBox "您正使用的工作表索引號爲" & i
End Sub
--------------------------------------------------------------------------------
[示例04-09]選取前一個工作表(Previous屬性)
Sub PreviousSheet()
If ActiveSheet.Index <> 1 Then
MsgBox "選取當前工作簿中當前工作表的前一個工作表"
ActiveSheet.Previous.Activate
Else
MsgBox "已到第一個工作表"
End If
End Sub
示例說明：如果當前工作表是第一個工作表，則使用Previous屬性會出錯。
--------------------------------------------------------------------------------
[示例04-10]選取下一個工作表(Next屬性)
Sub NextSheet()
If ActiveSheet.Index <> Worksheets.Count Then
MsgBox "選取當前工作簿中當前工作表的下一個工作表"
ActiveSheet.Next.Activate
Else
MsgBox “已到最後一個工作表”
End If
End Sub
示例說明：如果當前工作表是最後一個工作表，則使用Next屬性會出錯。
--------------------------------------------------------------------------------
[示例04-11]工作表行和列的操作
[示例04-11-01]隱藏行
Sub HideRow()
Dim iRow As Long
MsgBox "隱藏當前單元格所在的行"
iRow = ActiveCell.Row
ActiveSheet.Rows(iRow).Hidden = True
MsgBox "取消隱藏"
ActiveSheet.Rows(iRow).Hidden = False
End Sub
--------------------------------------------------------------------------------
[示例04-11-02]隱藏列
Sub HideColumn()
Dim iColumn As Long
MsgBox "隱藏當前單元格所在列"
iColumn = ActiveCell.Column
ActiveSheet.Columns(iColumn).Hidden = True
MsgBox "取消隱藏"
ActiveSheet.Columns(iColumn).Hidden = False
End Sub
--------------------------------------------------------------------------------
[示例04-11-03]插入行
Sub InsertRow()
Dim rRow As Long
MsgBox "在當前單元格上方插入一行"
rRow = Selection.Row
ActiveSheet.Rows(rRow).Insert
End Sub
--------------------------------------------------------------------------------
[示例04-11-04]插入列
Sub InsertColumn()
Dim cColumn As Long
MsgBox "在當前單元格所在行的左邊插入一行"
cColumn = Selection.Column
ActiveSheet.Columns(cColumn).Insert
End Sub
--------------------------------------------------------------------------------
[示例04-11-05]插入多行
Sub InsertManyRow()
MsgBox "在當前單元格所在行上方插入三行"
Dim rRow As Long, i As Long
For i = 1 To 3
rRow = Selection.Row
ActiveSheet.Rows(rRow).Insert
Next i
End Sub
--------------------------------------------------------------------------------
[示例04-11-06]設置行高
Sub SetRowHeight()
MsgBox "將當前單元格所在的行高設置爲25"
Dim rRow As Long, iRow As Long
rRow = ActiveCell.Row
iRow = ActiveSheet.Rows(rRow).RowHeight
ActiveSheet.Rows(rRow).RowHeight = 25
MsgBox "恢復到原來的行高"
ActiveSheet.Rows(rRow).RowHeight = iRow
End Sub
--------------------------------------------------------------------------------
[示例04-11-07]設置列寬
Sub SetColumnWidth()
MsgBox "將當前單元格所在列的列寬設置爲20"
Dim cColumn As Long, iColumn As Long
cColumn = ActiveCell.Column
iColumn = ActiveSheet.Columns(cColumn).ColumnWidth
ActiveSheet.Columns(cColumn).ColumnWidth = 20
MsgBox "恢復至原來的列寬"
ActiveSheet.Columns(cColumn).ColumnWidth = iColumn
End Sub
--------------------------------------------------------------------------------
[示例04-11-08]恢復行高列寬至標準值
Sub ReSetRowHeightAndColumnWidth()
MsgBox "將當前單元格所在的行高和列寬恢復爲標準值"
Selection.UseStandardHeight = True
Selection.UseStandardWidth = True
End Sub
--------------------------------------------------------------------------------
[示例04-12]工作表標籤
[示例04-12-01] 設置工作表標籤的顏色
Sub SetSheetTabColor()
MsgBox "設置當前工作表標籤的顏色"
ActiveSheet.Tab.ColorIndex = 7
End Sub
--------------------------------------------------------------------------------
[示例04-12-01]恢復工作表標籤顏色
Sub SetSheetTabColorDefault()
MsgBox "將當前工作表標籤顏色設置爲默認值"
ActiveSheet.Tab.ColorIndex = -4142
End Sub
--------------------------------------------------------------------------------
[示例04-12-03]交替隱藏或顯示工作表標籤
Sub HideOrShowSheetTab()
MsgBox "隱藏/顯示工作表標籤"
ActiveWindow.DisplayWorkbookTabs = Not ActiveWindow.DisplayWorkbookTabs
End Sub
--------------------------------------------------------------------------------
[NextPage][示例04-13]確定打印的頁數(HPageBreaks屬性與VPageBreaks屬性)
Sub PageCount()
Dim i As Long
i = (ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1)
MsgBox "當前工作表共" & i & "頁."
End Sub
--------------------------------------------------------------------------------
[示例04-14]保護/撤銷保護工作表
[示例04-14-01]
Sub ProtectSheet()
MsgBox "保護當前工作表並設定密碼"
ActiveSheet.Protect Password:="fanjy"
End Sub
示例說明：運行代碼後，當前工作表中將不允許編輯，除非撤銷工作表保護。
--------------------------------------------------------------------------------
[示例04-14-02]
Sub UnprotectSheet()
MsgBox "撤銷當前工作表保護"
ActiveSheet.Unprotect
End Sub
示例說明：運行代碼後，如果原保護的工作表設置有密碼，則要求輸入密碼。
--------------------------------------------------------------------------------
[示例04-14-03]保護當前工作簿中的所有工作表
Sub ProtectAllWorkSheets()
On Error Resume Next
Dim ws As Worksheet
Dim myPassword As String
myPassword = InputBox("請輸入您的密碼" & vbCrLf & _
"(不輸入表明無密碼)" & vbCrLf & vbCrLf & _
"確保您沒有忘記密碼！", "輸入密碼")
For Each ws In ThisWorkbook.Worksheets
ws.Protect (myPassword)
Next ws
End Sub
--------------------------------------------------------------------------------
[示例04-14-04]撤銷對當前工作簿中所有工作表的保護
Sub UnprotectAllWorkSheets()
On Error Resume Next
Dim ws As Worksheet
Dim myPassword As String
myPassword = InputBox("請輸入您的密碼" & vbCrLf & _
"(不輸入表示無密碼)", "輸入密碼")
For Each ws In ThisWorkbook.Worksheets
ws.Unprotect (myPassword)
Next ws
End Sub
--------------------------------------------------------------------------------
[示例04-14-05]僅能編輯未鎖定的單元格
Sub OnlyEditUnlockedCells()
Sheets("Sheet1").EnableSelection = xlUnlockedCells
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
示例說明：運行本代碼後，在當前工作表中將只能對未鎖定的單元格進行編輯，而其它單元格將不能編輯。未鎖定的單元格是指在選擇菜單“格式——單元格”命令後所彈出的對話框中的“保護”選項卡中，未選中“鎖定”複選框的單元格或單元格區域。
--------------------------------------------------------------------------------
[示例04-15]刪除工作表(Delete方法)
Sub DeleteWorksheet()
MsgBox "刪除當前工作簿中的工作表sheet2"
Application.DisplayAlerts = False
Worksheets("sheet2").Delete
Application.DisplayAlerts = True
End Sub
示例說明：本示例代碼使用Application.DisplayAlerts = False來屏蔽彈出的警告框。
--------------------------------------------------------------------------------
<一些編程方法和技巧>
[示例04-16] 判斷一個工作表(名)是否存在
[示例04-16-01]
Sub testWorksheetExists1()
Dim ws As Worksheet
If Not WorksheetExists(ThisWorkbook, "sheet1") Then
MsgBox "不能夠找到該工作表", vbOKOnly
Exit Sub
End If
MsgBox "已經找到工作表"
Set ws = ThisWorkbook.Worksheets("sheet1")
End Sub
'- - - - - - - - - - - - - - - - - - -
Function WorksheetExists(wb As Workbook, sName As String) As Boolean
Dim s As String
On Error GoTo ErrHandle
s = wb.Worksheets(sName).Name
WorksheetExists = True
Exit Function
ErrHandle:
WorksheetExists = False
End Function
示例說明：在測試代碼中，用相應的工作簿名和工作表名分別代替“ThisWorkbook”和“Sheet1”，來判斷指定工作表是否在工作簿中存在。
--------------------------------------------------------------------------------
[示例04-16-02]
Sub testWorksheetExists2()
If Not SheetExists("<工作表名>") Then
MsgBox "<工作表名> 不存在!"
Else
Sheets("<工作表名>").Activate
End If
End Sub
'- - - - - - - - - - - - - - - - - - -
Function SheetExists(SheetName As String) As Boolean
SheetExists = False
On Error GoTo NoSuchSheet
If Len(Sheets(SheetName).Name) > 0 Then
SheetExists = True
Exit Function
End If
NoSuchSheet:
End Function
示例說明：在代碼中，用實際工作表名代替<>。
--------------------------------------------------------------------------------
[示例04-16-03]
Sub TestingFunction()
'如果工作表存在則返回True，否則爲False
'測試DoesWksExist1函數
Debug.Print DoesWksExist1("Sheet1")
Debug.Print DoesWksExist1("Sheet100")
Debug.Print "-----"
'測試DoesWksExist2函數
Debug.Print DoesWksExist2("Sheet1")
Debug.Print DoesWksExist2("Sheet100")
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function DoesWksExist1(sWksName As String) As Boolean
Dim i As Long
For i = Worksheets.Count To 1 Step -1
If Sheets(i).Name = sWksName Then
Exit For
End If
Next
If i = 0 Then
DoesWksExist1 = False
Else
DoesWksExist1 = True
End If
End Function
‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function DoesWksExist2(sWksName As String) As Boolean
Dim wkb As Worksheet
On Error Resume Next
Set wkb = Sheets(sWksName)
On Error GoTo 0
DoesWksExist2 = IIf(Not wkb Is Nothing, True, False)
End Function
--------------------------------------------------------------------------------
[示例04-17]排序工作表
[示例04-17-01]
Sub SortWorksheets1()
Dim bSorted As Boolean
Dim nSortedSheets As Long
Dim nSheets As Long
Dim n As Long
nSheets = Worksheets.Count
nSortedSheets = 0
Do While (nSortedSheets < nSheets) And Not bSorted
bSorted = True
nSortedSheets = nSortedSheets + 1
For n = 1 To nSheets - nSortedSheets
If StrComp(Worksheets(n).Name, Worksheets(n + 1).Name, vbTextCompare) > 0 Then
Worksheets(n + 1).Move Before:=Worksheets(n)
bSorted = False
End If
Next n
Loop
End Sub
示例說明：本示例代碼採用了冒泡法排序。
--------------------------------------------------------------------------------
[示例04-17-02]
Sub SortWorksheets2()
'根據字母對工作表排序
Dim i As Long, j As Long
For i = 1 To Sheets.Count
For j = 1 To Sheets.Count - 1
If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
Sheets(j).Move After:=Sheets(j + 1)
End If
Next j
Next i
End Sub
--------------------------------------------------------------------------------
[示例04-17-03]
Sub SortWorksheets3()
'以升序排列工作表
Dim sCount As Integer, i As Integer, j As Integer
Application.ScreenUpdating = False
sCount = Worksheets.Count
If sCount = 1 Then Exit Sub
For i = 1 To sCount - 1
For j = i + 1 To sCount
If Worksheets(j).Name < Worksheets(i).Name Then
Worksheets(j).Move Before:=Worksheets(i)
End If
Next j
Next i
End Sub
示例說明：若想排序所有工作表，將代碼中的Worksheets替換爲Sheets。
--------------------------------------------------------------------------------
[示例04-18]刪除當前工作簿中的空工作表
Sub Delete_EmptySheets()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If Application.WorksheetFunction.CountA(sh.Cells) = 0 Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next
End Sub
單元格區域引用方式的小結
在使用ExcelVBA進行編程時，我們通常需要頻繁地引用單元格區域，然後再使用相應的屬性和方法對區域進行操作。所謂單元格區域，指的是單個的單元格、或者是由多個單元格組成的區域、或者是整行、整列等。下面，我們設定一些情形，以問答的形式對引用單元格區域的方式進行歸納。
--------------------------------------------------------------------------------
問題一：在VBA代碼中，如何引用當前工作表中的單個單元格(例如引用單元格C3)？
回答：可以使用下面列舉的任一方式對當前工作表中的單元格(C3)進行引用。
(1) Range("C3")
(2) [C3]
(3) Cells(3, 3)
(4) Cells(3, "C")
(5) Range("C4").Offset(-1)
Range("D3").Offset(, -1)
Range("A1").Offset(2, 2)
(6) 若C3爲當前單元格，則可使用：ActiveCell
(7) 若將C3單元格命名爲“Range1”，則可使用：Range("Range1")或[Range1]
(8) Cells(4, 3).Offset(-1)
(9) Range("A1").Range("C3")
--------------------------------------------------------------------------------
問題二：在VBA代碼中，我要引用當前工作表中的B2:D6單元格區域，有哪些方式？
回答：可以使用下面列舉的任一方式對當前工作表中單元格區域B2:D6進行引用。
(1) Range(“B2:D6”)
(2) Range("B2", "D6")
(3) [B2:D6]
(4) Range(Range("B2"), Range("D6"))
(5) Range(Cells(2, 2), Cells(6, 4))
(6) 若將B2:D6區域命名爲“MyRange”，則又可以使用下面的語句引用該區域：
① Range("MyRange")
② [MyRange]
(7) Range("B2").Resize(5, 3)
(8) Range("A1:C5").Offset(1, 1)
(9) 若單元格B2爲當前單元格，則可使用語句：Range(ActiveCell, ActiveCell.Offset(4, 2))
(10) 若單元格D6爲當前單元格，則可使用語句：Range("B2", ActiveCell)
--------------------------------------------------------------------------------
問題三：在VBA代碼中，如何使用變量實現對當前工作表中不確定單元格區域的引用？
回答：有時，我們需要在代碼中依次獲取工作表中特定區域內的單元格，這通常可以採取下面的幾種方式：
(1) Range(“A” & i)
(2) Range(“A” & i & “:C” & i)
(3) Cells(i,1)
(4) Cells(i,j)
其中，i、j爲變量，在循環語句中指定i和j的範圍後，依次獲取相應單元格。
--------------------------------------------------------------------------------
問題四：在VBA代碼中，如何擴展引用當前工作表中的單元格區域？
回答：可以使用Resize屬性，例如：
(1) ActiveCell.Resize(4, 4)，表示自當前單元格開始創建一個4行4列的區域。
(2) Range("B2").Resize(2, 2)，表示創建B2:C3單元格區域。
(3) Range("B2").Resize(2)，表示創建B2:B3單元格區域。
(4) Range("B2").Resize(, 2)，表示創建B2:C2單元格區域。
如果是在一個單元格區域(如B3:E6)，或一個命名區域中(如將單元格區域B3:E6命名爲“MyRange”)使用Resize屬性，則只是相對於單元格區域左上角單元格擴展區域，例如：
代碼Range("C3:E6").Resize(, 2)，表示單元格區域C3：D6，並且擴展的單元格區域可不在原單元格區域內。
因此，可以知道Resize屬性是相對於當前活動單元格或某單元格區域中左上角單元格按指定的行數或列數擴展單元格區域。
--------------------------------------------------------------------------------
問題五：在VBA代碼中，如何在當前工作表中基於當前單元格區域或指定單元格區域處理其它單元格區域？
回答：可以使用Offset屬性，例如：
(1) Range("A1").Offset(2, 2)，表示單元格C3。
(2) ActiveCell.Offset(, 1)，表示當前單元格下一列的單元格。
(3) ActiveCell.Offset(1)，表示當前單元格下一行的單元格。
(4) Range("C3:D5").Offset(, 1)，表示單元格區域D3:E5，即將整個區域偏移一列。
從上面的代碼示例可知，Offset屬性從所指定的單元格開始按指定的行數和列數偏移，從而到達目的單元格，但偏移的行數和列數不包括指定單元格本身。
--------------------------------------------------------------------------------
問題六：在VBA代碼中，如何在當前工作表中引用交叉區域？
回答：可以使用Intersect方法，例如：
Intersect(Range("C3:E6"), Range("D5:F8"))，表示單元格區域D5:E6，即單元格區域C3:E6與D5:F8相重迭的區域。
--------------------------------------------------------------------------------
問題七：在VBA代碼中，如何在當前工作表中引用多個區域？
回答：
(1) 可以使用Union方法，例如：
Union(Range("C3:D4"), Range("E5:F6"))，表示單元格區域C3:D4和E5:F6所組成的區域。
Union方法可以將多個非連續區域連接起來成爲一個區域，從而可以實現對多個非連續區域一起進行操作。
(2) 也可以使用下面的代碼：
Range("C3:D4, E5:F6")或[C3:D4, E5:F6]
注意：Range("C3:D4", "F5:G6")，表示單元格區域C3:G6，即將兩個區域以第一個區域左上角單元格爲起點，以第二個區域右下角單元格爲終點連接成一個新區域。
同時，在引用區域後使用Rows屬性和Columns屬性時，注意下面代碼的區別：
①Range("C3:D4", "F8:G10").Rows.Count，返回的值爲8；
②Range("C3:D4,F8:G10").Rows.Count，返回的值爲2，即只計算第一個單元格區域。
--------------------------------------------------------------------------------
問題八：在VBA代碼中，如何引用當前工作表中活動單元格或指定單元格所在的區域(當前區域)？
回答：可以使用CurrentRegion屬性，例如：
(1) ActiveCell.CurrentRegion，表示活動單元格所在的當前區域。
(2) Range("D5").CurrentRegion，表示單元格D5所在的當前區域。
當前區域是指周圍由空行或空列所圍成的區域。該屬性的詳細使用參見《CurrentRegion屬性示例》一文。
[NextPage]
--------------------------------------------------------------------------------
問題九：在VBA代碼中，如何引用當前工作表中已使用的區域？
回答：可以使用UsedRange屬性，例如：
(1) Activesheet.UsedRange，表示當前工作表中已使用的區域。
(2) Worksheets("sheet1").UsedRange，表示工作表sheet1中已使用的區域。
與CurrentRegion屬性不同的是，該屬性代表工作表中已使用的單元格區域，包括顯示爲空行，但已進行過格式的單元格區域。該屬性的詳細使用參見《解析UsedRange屬性》一文。
--------------------------------------------------------------------------------
問題十：如何在單元格區域內指定特定的單元格？
回答：可以使用Item屬性，例如：
(1) Range("A1:B10").Item(5,3)指定單元格C5，這個單元格處於以區域中左上角單元格A1(即區域中第1行第1列的單元格)爲起點的第5行第3列。因爲Item屬性爲默認屬性，因此也可以簡寫爲：Range("A1:B10")(5,3)。
如果將A1:B10區域命名爲”MyRange”，那麼Range("MyRange")(5,3)也指定單元格C5。
(2) Range("A1:B10")(12,13)指定單元格M12，即用這種方式引用單元格，該單元格不必一定要包含在區域內。
同時，也不需要索引數值是正值，例如：
① Range("D4:F6")(0,0)代表單元格C3；
② Range("D4:F6")(-1,-2)代表單元格A2。
而Range("D4:F6")(1,1)代表單元格D4。
(3) 也可以在單元格區域中循環，例如：
Range("D4:F6")(2,2)(3,4)代表單元格H7，即該單元格位於作爲左上角單元格E5的第3行第4列(因爲E5是開始於區域中左上角單元格D4起的第2行第2列)。
(4) 也能使用一個單個的索引數值進行引用。計數方式爲從左向右，即在區域中的第一行開始從左向右計數，第一行結束後，然後從第二行開始從左到右接着計數，依次類推。(注：從區域中第一行第一個單元格開始計數，當第一行結束時，轉入第二行最左邊的單元格，這樣按一行一行從左向右依次計數。以單元格區域中第1個單元格開始，按上述規則依次爲第2個單元格、第3個單元格….等等)，例如：
Range("A1:B2")(1) 代表單元格A1；
Range("A1:B2")(2) 代表單元格B1；
Range("A1:B2")(3) 代表單元格A2；
Range("A1:B2")(4) 代表單元格B2。
這種方法可在工作表中連續向下引用單元格(即不一定是在單元格區域內，但在遵循相同的規律)，例如：
Range("A1:B2")(5)代表單元格A3；
Range("A1:B2")(14)代表單元格B7，等等。
也可以使用單個的負數索引值。
這種使用單個索引值的方法對遍歷列是有用的，例如，Range("D4")(1)代表單元格D4，Range("D4")(2)代表單元格D5，Range ("D4")(11)代表單元格D14，等等。
同理，稍作調整後也可遍歷行，例如：
Range("D4").Columns(2)代表單元格E4，Range("D4").Columns(5)指定單元格H4，等等。
(5)當與對象變量配合使用時，Item屬性能提供簡潔並有效的代碼，例如：
Set rng = Worksheets(1).[a1]
定義了對象變量後，像單元格方法一樣，Item屬性允許使用兩個索引數值引用工作表中的任一單元格，例如，rng(3,4)指定單元格D3。(By Chip Pearson)
--------------------------------------------------------------------------------
問題十一：在VBA代碼中，如何引用當前工作表中的整行或整列？
回答：見下面的示例代碼：
(1) Range("C:C").Select，表示選擇C列。
Range("C:E").Select，表示選擇C列至E列。
(2) Range("1:1").Select，表示選擇第一行。
Range("1:3").Select，表示選擇第1行至第3行。
(3) Range("C:C").EntireColumn，表示C列；
Range("D1").EntireColumn，表示D列。
同樣的方式，也可以選擇整行，然後可以使用如AutoFit方法對整列或整行進行調整。
--------------------------------------------------------------------------------
問題十二：在VBA代碼中，如何引用當前工作表中的所有單元格？
回答：可以使用下面的代碼：
(1) Cells，表示當前工作表中的所有單元格。
(2) Range(Cells(1, 1), Cells(Cells.Rows.Count, Cells. Columns.Count))，其中Cells.Rows表示工作表所有行，Cells. Columns表示工作表所有列。
--------------------------------------------------------------------------------
問題十三：在VBA代碼中，如何引用工作表中的特定單元格區域？
回答：在工作表中，您可能使用過“定位條件”對話框。可以通過選擇菜單“編輯——定位”，單擊“定位”對話框中的“定位條件”按鈕顯示該對話框。這個對話框可以允許用戶選擇特定的單元格。例如：
(1) Worksheets("sheet1").Cells.SpecialCells(xlCellTypeAllFormatConditions)，表示工作表sheet1中由帶有條件格式的單元格所組成的區域。
(2) ActiveCell.CurrentRegion.SpecialCells(xlCellTypeBlanks)，表示當前工作表中活動單元格所在區域中所有空白單元格所組成的區域。
當然，還有很多常量和值的組合，可以讓您實現特定單元格的查找並引用。參見《探討在工作表中找到最後一行》一文。
--------------------------------------------------------------------------------
問題十四：在VBA代碼中，如何引用其它工作表或其它工作簿中的單元格區域？
回答：要引用其它工作表或其它工作簿中的單元格區域，只需在單元格對象前加上相應的引用對象即可，例如：
(1) Worksheets(“Sheet3”).Range(“C3:D5”)，表示引用工作表sheet3中的單元格區域C3:D5。
(2) Workbooks(“MyBook.xls”).Worksheets(“sheet1”).Range(“B2”)，表示引用MyBook工作簿中工作表Sheet1上的單元格B2。
--------------------------------------------------------------------------------
問題十五：還有其它的一些情形嗎？
回答：列舉如下：
(1) Cells(15)，表示單元格O1，即可在Cells屬性中指定單元格數字來選擇單元格，其計數順序爲自左至右、從上到下，又如Cells(257)，表示單元格B1。
(2) Cells(, 256)，表示單元格IV1，但是如果Cells(, 257)，則會返回錯誤。
--------------------------------------------------------------------------------
結語
我們用VBA對Excel進行處理，一般是對其工作表中的數據進行處理，因此，引用單元格區域是ExcelVBA編程中最基本的操作之一，只有確定了所處理的單元格區域，才能使用相應的屬性和方法進行下一步的操作。
上面列舉了一些引用單元格區域的情形和方式，可以看出，引用單元格區域有很多方式，有一些可能不常用，可以根據工作表的所處的環境和個人編程習慣進行選擇使用。
當然，在編寫程序時，也可能會將上面的一些屬性聯合使用，以達到選取特定操作對象的目的，例如Offset屬性、Resize屬性、CurrentRegion屬性、UsedRange屬性等的組合。
Excel工作表探密
Sheets集合與Worksheets集合的區別
Sheets集合代表當前工作簿中的所有工作表,包括圖表工作表、對話框工作表和宏表。
Worksheets集合僅代表當前工作簿中的所有工作表。
如下圖1所示的工作簿。
圖1
在VBE編輯器中輸入如下代碼進行測試：
MsgBox Sheets(1).Name ‘返回Chart1
MsgBox Worksheets(1).Name ‘返回Sheet1
MsgBox Sheets.Count ‘返回6
MsgBox Worksheets.Count ‘返回3
--------------------------------------------------------------------------------
Activate方法與Select方法的區別
當需要激活或者是選擇某個工作表時，使用Sheets(1).Activate和Sheets(1).Select的作用表面上看起來是相同的。但是，如果將需要激活或者是選擇的工作表隱藏後，使用Sheets(1).Select將會出現錯誤，而使用Sheets(1).Activate則會正常運行。如下代碼：
‘- - - 下面的代碼運行正常 - - - -
Sub test1()
Sheets(1).Visible = xlHidden
Sheets(1).Activate
End Sub
‘- - - 下面的代碼運行錯誤，作用於對象的方法無效 - - - -
Sub test2()
Sheets(1).Visible = xlHidden
Sheets(1).Select
End Sub
Activate方法是用來激活對象的方法，而Select方法是用來選取對象的方法，能使用Select方法一次選取多個工作表，但不能使用Activate方法一次激活多個工作表，一次只能激活一個工作表。見下面的代碼示例：
‘- - - 下面的代碼運行正常 - - - -
Sub Test3()
ActiveWorkbook.Sheets(Array(1, 2, 3)).Select
End Sub
‘- - - 下面的代碼運行錯誤，對象不支持該屬性和方法 - - - -
Sub Test4()
ActiveWorkbook.Sheets(Array(1, 2, 3)).Activate
End Sub
當然，上述內容同樣適用於Worksheets集合。