在編寫代碼時,經常要引用工作表的名字、知道工作表在工作簿中的位置、增加工作表、刪除工作表、復制工作表、移動工作表、重命名工作表,等等。下面介紹與此有關及相關的一些屬性和方法示例。
[示例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