在編寫代碼時(shí)，經(jīng)常要引用工作表的名字、知道工作表在工作簿中的位置、增加工作表、刪除工作表、復(fù)制工作表、移動工作表、重命名工作表，等等。下面介紹與此有關(guān)及相關(guān)的一些屬性和方法示例。
--------------------------------------------------------------------------------
[示例04-01]增加工作表(Add方法)
Sub AddWorksheet()
  MsgBox "在當(dāng)前工作簿中添加一個(gè)工作表"
  Worksheets.Add
  MsgBox "在當(dāng)前工作簿中的工作表sheet2之前添加一個(gè)工作表"
  Worksheets.Add before:=Worksheets("sheet2")
  MsgBox "在當(dāng)前工作簿中的工作表sheet2之后添加一個(gè)工作表"
  Worksheets.Add after:=Worksheets("sheet2")
  MsgBox "在當(dāng)前工作簿中添加3個(gè)工作表"
  Worksheets.Add Count:=3
End Sub
示例說明：Add方法帶有4個(gè)可選的參數(shù)，其中參數(shù)Before和參數(shù)After指定所增加的工作表的位置，但兩個(gè)參數(shù)只能選一；參數(shù)Count用來指定增加的工作表數(shù)目。
--------------------------------------------------------------------------------
[示例04-02]復(fù)制工作表(Copy方法)
Sub CopyWorksheet()
  MsgBox "在當(dāng)前工作簿中復(fù)制工作表sheet1并將所復(fù)制的工作表放在工作表sheet2之前"
  Worksheets("sheet1").Copy Before:=Worksheets("sheet2")
  MsgBox "在當(dāng)前工作簿中復(fù)制工作表sheet2并將所復(fù)制的工作表放在工作表sheet3之后"
  Worksheets("sheet2").Copy After:=Worksheets("sheet3")
End Sub
示例說明：Copy方法帶有2個(gè)可選的參數(shù)，即參數(shù)Before和參數(shù)After，在使用時(shí)兩個(gè)參數(shù)只參選一。
--------------------------------------------------------------------------------
[示例04-03]移動工作表(Move方法)
Sub MoveWorksheet()
  MsgBox "在當(dāng)前工作簿中將工作表sheet3移至工作表sheet2之前"
  Worksheets("sheet3").Move Before:=Worksheets("sheet2")
  MsgBox "在當(dāng)前工作簿中將工作表sheet1移至最后"
  Worksheets("sheet1").Move After:=Worksheets(Worksheets.Count)
End Sub
示例說明：Move方法與Copy方法的參數(shù)相同，作用也一樣。
--------------------------------------------------------------------------------
[示例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 "使當(dāng)前工作簿中的所有工作表都顯示(即將隱藏的工作表也顯示)"
  Dim ws As Worksheet
  For Each ws In Sheets
    ws.Visible = True
  Next ws
End Sub
--------------------------------------------------------------------------------
[示例04-05]獲取工作表數(shù)(Count屬性)
[示例04-05-01]
Sub WorksheetNum()
  Dim i As Long
  i = Worksheets.Count
  MsgBox "當(dāng)前工作簿的工作表數(shù)為：" & Chr(10) & i
End Sub
--------------------------------------------------------------------------------
[示例04-05-02]
Sub WorksheetNum()
  Dim i As Long
  i = Sheets.Count
  MsgBox "當(dāng)前工作簿的工作表數(shù)為：" & Chr(10) & i
End Sub
示例說明：在一個(gè)包含圖表工作表的工作簿中運(yùn)行上述兩段代碼，將會得出不同的結(jié)果，原因是對于Sheets集合來講，工作表包含圖表工作表。應(yīng)注意Worksheets集合與Sheets集合的區(qū)別，下同。
--------------------------------------------------------------------------------
[示例04-06]獲取或設(shè)置工作表名稱(Name屬性)
[示例04-06-01]
Sub NameWorksheet()
  Dim sName As String, sChangeName As String
  sName = Worksheets(2).Name
  MsgBox "當(dāng)前工作簿中第2個(gè)工作表的名字為：" & sName
  sChangeName = "我的工作表"
  MsgBox "將當(dāng)前工作簿中的第3個(gè)工作表名改為：" & sChangeName
  Worksheets(3).Name = sChangeName
End Sub
示例說明：使用Name屬性可以獲取指定工作表的名稱，也可以設(shè)置工作表的名稱。
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 "激活當(dāng)前工作簿中的工作表sheet2"
  Worksheets("sheet2").Activate
  MsgBox "激活當(dāng)前工作簿中的工作表sheet3"
  Worksheets("sheet3").Select
  MsgBox "同時(shí)選擇工作簿中的工作表sheet2和sheet3"
  Worksheets(Array("sheet2", "sheet3")).Select
End Sub
示例說明：Activate方法只能激活一個(gè)工作表，而Select方法可以同時(shí)選擇多個(gè)工作表。
--------------------------------------------------------------------------------
[示例04-07-02]
Sub SelectManySheet()
  MsgBox "選取第一個(gè)和第三個(gè)工作表."
  Worksheets(1).Select
  Worksheets(3).Select False
End Sub
--------------------------------------------------------------------------------
[示例04-08]獲取當(dāng)前工作表的索引號(Index屬性)
Sub GetSheetIndex()
  Dim i As Long
  i = ActiveSheet.Index
  MsgBox "您正使用的工作表索引號為" & i
End Sub
--------------------------------------------------------------------------------
[示例04-09]選取前一個(gè)工作表(Previous屬性)
Sub PreviousSheet()
  If ActiveSheet.Index <> 1 Then
    MsgBox "選取當(dāng)前工作簿中當(dāng)前工作表的前一個(gè)工作表"
    ActiveSheet.Previous.Activate
  Else
    MsgBox "已到第一個(gè)工作表"
  End If
End Sub
示例說明：如果當(dāng)前工作表是第一個(gè)工作表，則使用Previous屬性會出錯(cuò)。
--------------------------------------------------------------------------------
[示例04-10]選取下一個(gè)工作表(Next屬性)
Sub NextSheet()
  If ActiveSheet.Index <> Worksheets.Count Then
    MsgBox "選取當(dāng)前工作簿中當(dāng)前工作表的下一個(gè)工作表"
    ActiveSheet.Next.Activate
  Else
    MsgBox “已到最后一個(gè)工作表”
  End If
End Sub
示例說明：如果當(dāng)前工作表是最后一個(gè)工作表，則使用Next屬性會出錯(cuò)。
--------------------------------------------------------------------------------
[示例04-11]工作表行和列的操作
[示例04-11-01]隱藏行
Sub HideRow()
  Dim iRow As Long
  MsgBox "隱藏當(dāng)前單元格所在的行"
  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 "隱藏當(dāng)前單元格所在列"
  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 "在當(dāng)前單元格上方插入一行"
  rRow = Selection.Row
  ActiveSheet.Rows(rRow).Insert
End Sub
--------------------------------------------------------------------------------
[示例04-11-04]插入列
Sub InsertColumn()
  Dim cColumn As Long
  MsgBox "在當(dāng)前單元格所在行的左邊插入一行"
  cColumn = Selection.Column
  ActiveSheet.Columns(cColumn).Insert
End Sub
--------------------------------------------------------------------------------
[示例04-11-05]插入多行
Sub InsertManyRow()
  MsgBox "在當(dāng)前單元格所在行上方插入三行"
  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]設(shè)置行高
Sub SetRowHeight()
  MsgBox "將當(dāng)前單元格所在的行高設(shè)置為25"
  Dim rRow As Long, iRow As Long
  rRow = ActiveCell.Row
  iRow = ActiveSheet.Rows(rRow).RowHeight
  ActiveSheet.Rows(rRow).RowHeight = 25
  MsgBox "恢復(fù)到原來的行高"
  ActiveSheet.Rows(rRow).RowHeight = iRow
End Sub
--------------------------------------------------------------------------------
[示例04-11-07]設(shè)置列寬
Sub SetColumnWidth()
  MsgBox "將當(dāng)前單元格所在列的列寬設(shè)置為20"
  Dim cColumn As Long, iColumn As Long
  cColumn = ActiveCell.Column
  iColumn = ActiveSheet.Columns(cColumn).ColumnWidth
  ActiveSheet.Columns(cColumn).ColumnWidth = 20
  MsgBox "恢復(fù)至原來的列寬"
  ActiveSheet.Columns(cColumn).ColumnWidth = iColumn
End Sub
--------------------------------------------------------------------------------
[示例04-11-08]恢復(fù)行高列寬至標(biāo)準(zhǔn)值
Sub ReSetRowHeightAndColumnWidth()
  MsgBox "將當(dāng)前單元格所在的行高和列寬恢復(fù)為標(biāo)準(zhǔn)值"
  Selection.UseStandardHeight = True
  Selection.UseStandardWidth = True
End Sub
--------------------------------------------------------------------------------
[示例04-12]工作表標(biāo)簽
[示例04-12-01] 設(shè)置工作表標(biāo)簽的顏色
Sub SetSheetTabColor()
  MsgBox "設(shè)置當(dāng)前工作表標(biāo)簽的顏色"
  ActiveSheet.Tab.ColorIndex = 7
End Sub
--------------------------------------------------------------------------------
[示例04-12-01]恢復(fù)工作表標(biāo)簽顏色
Sub SetSheetTabColorDefault()
  MsgBox "將當(dāng)前工作表標(biāo)簽顏色設(shè)置為默認(rèn)值"
  ActiveSheet.Tab.ColorIndex = -4142
End Sub
--------------------------------------------------------------------------------
[示例04-12-03]交替隱藏或顯示工作表標(biāo)簽
Sub HideOrShowSheetTab()
  MsgBox "隱藏/顯示工作表標(biāo)簽"
  ActiveWindow.DisplayWorkbookTabs = Not ActiveWindow.DisplayWorkbookTabs
End Sub
--------------------------------------------------------------------------------
[NextPage][示例04-13]確定打印的頁數(shù)(HPageBreaks屬性與VPageBreaks屬性)
Sub PageCount()
  Dim i As Long
  i = (ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1)
  MsgBox "當(dāng)前工作表共" & i & "頁."
End Sub
--------------------------------------------------------------------------------
[示例04-14]保護(hù)/撤銷保護(hù)工作表
[示例04-14-01]
Sub ProtectSheet()
  MsgBox "保護(hù)當(dāng)前工作表并設(shè)定密碼"
  ActiveSheet.Protect Password:="fanjy"
End Sub
示例說明：運(yùn)行代碼后，當(dāng)前工作表中將不允許編輯，除非撤銷工作表保護(hù)。
--------------------------------------------------------------------------------
[示例04-14-02]
Sub UnprotectSheet()
  MsgBox "撤銷當(dāng)前工作表保護(hù)"
  ActiveSheet.Unprotect
End Sub
示例說明：運(yùn)行代碼后，如果原保護(hù)的工作表設(shè)置有密碼，則要求輸入密碼。
--------------------------------------------------------------------------------
[示例04-14-03]保護(hù)當(dāng)前工作簿中的所有工作表
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]撤銷對當(dāng)前工作簿中所有工作表的保護(hù)
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
示例說明：運(yùn)行本代碼后，在當(dāng)前工作表中將只能對未鎖定的單元格進(jìn)行編輯，而其它單元格將不能編輯。未鎖定的單元格是指在選擇菜單“格式——單元格”命令后所彈出的對話框中的“保護(hù)”選項(xiàng)卡中，未選中“鎖定”復(fù)選框的單元格或單元格區(qū)域。
--------------------------------------------------------------------------------
[示例04-15]刪除工作表(Delete方法)
Sub DeleteWorksheet()
  MsgBox "刪除當(dāng)前工作簿中的工作表sheet2"
  Application.DisplayAlerts = False
  Worksheets("sheet2").Delete
  Application.DisplayAlerts = True
End Sub
示例說明：本示例代碼使用Application.DisplayAlerts = False來屏蔽彈出的警告框。
--------------------------------------------------------------------------------
<一些編程方法和技巧>
[示例04-16] 判斷一個(gè)工作表(名)是否存在
[示例04-16-01]
Sub testWorksheetExists1()
  Dim ws As Worksheet
  If Not WorksheetExists(ThisWorkbook, "sheet1") Then
    MsgBox "不能夠找到該工作表", vbOKOnly
    Exit Sub
  End If
  MsgBox "已經(jīng)找到工作表"
  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
示例說明：在測試代碼中，用相應(yīng)的工作簿名和工作表名分別代替“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
示例說明：在代碼中，用實(shí)際工作表名代替<>。
--------------------------------------------------------------------------------
[示例04-16-03]
Sub TestingFunction()
 '如果工作表存在則返回True，否則為False
  '測試DoesWksExist1函數(shù)
  Debug.Print DoesWksExist1("Sheet1")
  Debug.Print DoesWksExist1("Sheet100")
  Debug.Print "-----"
  '測試DoesWksExist2函數(shù)
  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()
  '根據(jù)字母對工作表排序
  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]刪除當(dāng)前工作簿中的空工作表
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

最新評論