工作表(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属性可以获取指定工作表的名称，也可以设置工作表的名称。

　　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