在编写代码时，经常要引用工作表的名字、知道工作表在工作簿中的位置、增加工作表、删除工作表、复制工作表、移动工作表、重命名工作表，等等。下面介绍与此有关及相关的一些属性和方法示例。 -------------------------------------------------------------------------------- [示例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 |
