Worksheet物件表示Excel工作表，
可通過Workbooks集合物件和Worksheet物件的屬性、方法和事件對工作表進行操作和管理。
1.1 用Add方法新增工作表
Sub 新增工作表()
Dim str1 As String
On Error Resume Next
str1 = Application.InputBox(prompt:="請輸入已有工作表名稱， " & vbNewLine & _
"新增的工作表將位於該工作表前面。 ", _
Title:="輸入原工作表名稱", Type:=2)
Worksheets.Add Before:=Worksheets(str1)
End Sub
1.2 用Delete方法刪除工作表
Sub 刪除工作表()
Dim str1 As String
On Error GoTo err1
str1 = Application.InputBox(prompt:="請輸入要刪除的工作表名稱：", _
Title:="輸入工作表名稱", Type:=2)
If str1 = "False" Then Exit Sub
Application.DisplayAlerts = False '不顯示警告資訊
Worksheets(str1).Delete
Application.DisplayAlerts = True
Exit Sub
err1: '錯誤處理
MsgBox "不能刪除工作表“" & str1 & "”！"
Application.DisplayAlerts = True
End Sub
1.3 用Count屬性得到工作表數量
Sub 工作表數量()
Dim i As Long
i = Worksheets.Count
MsgBox "當前工作簿的工作表數為：" & i
End Sub
1.4 用Select方法選擇工作表
Worksheets(1).Select
2 使用工作表物件Worksheet管理工作表2.1 用copy方法複製工作表
Sub 複製工作表()
Dim ws1 As Worksheet
Set ws1 = ActiveSheet
MsgBox "複製當前工作到前面。 "
ws1.Copy Before:=ws1
MsgBox "得制當前工作表到後面。 "
ws1.Copy After:=ws1
End Sub
2.2 用Visible屬性隱藏工作表
Sub 隱藏工作表()
Dim str1 As String, ws1 As Worksheet
str1 = Application.InputBox(prompt:="請輸入需要隱藏的工作表：", _
Title:="隱藏工作表", Default:="Sheet1", Type:=2)
On Error GoTo err1
Set ws1 = Worksheets(str1)
ws1.Visible = xlSheetHidden
Exit Sub
err1:
MsgBox "輸入的工作表不存在！"
End Sub
2.3 用Move方法移動工作表
ActiveSheet.Move Before:=Sheets(1)
2.4 用Activate方法啟動工作表
Sub 逐個啟動工作表()
Dim sh As Worksheet
For Each sh In Worksheets
sh.Activate
MsgBox "啟動工作表名稱為：" & sh.Name & vbNewLine & _
"按一下【確定】按鈕將啟動下一工作表！"
Next
End Sub
2.5 用Previous、Next屬性選取前後工作表
Sub 選擇前工作表()
If ActiveSheet.Index <> 1 Then
ActiveSheet.Previous.Activate
Else
MsgBox "已到第一個工作表"
End If
End Sub
Sub 選擇後工作表()
If ActiveSheet.Index <> Worksheets.Count Then
ActiveSheet.Next.Activate
Else
MsgBox "已到最後一個工作表"
End If
End Sub
2.6 用ProtectContents屬性獲取工作表保護狀態
Sub 工作表保護狀態()
If ActiveSheet.ProtectContents Then
MsgBox "當前工作表已保護！"
Else
MsgBox "當前工作表未保護！"
End If
End Sub
2.7 用Protect方法保護工作表
Sub 保護工作表()
On Error Resume Next
Dim ws1 As Worksheet
Dim str1 As String
str1 = Application.InputBox(prompt:="請輸入保護工作表的密碼：", _
Title:="輸入密碼", Type:=2)
For Each ws1 In Worksheets
ws1.Protect Password:=str1
Next
MsgBox "所有工作表保護完成！"
End Sub
2.8 用Unprotected方法撤銷工作表的保護
Sub 撤銷工作表保護()
On Error GoTo err1
Dim ws1 As Worksheet
Dim str1 As String
str1 = Application.InputBox(prompt:="請輸入撤銷保護工作表的密碼：", _
Title:="輸入密碼", Type:=2)
For Each ws1 In Worksheets
ws1.Unprotect Password:=str1
Next
MsgBox "所有工作表的保護已被撤銷！"
Exit Sub
err1:
MsgBox "輸入的密碼錯誤， 不能取撤銷對工作表的保護！"
End Sub
2.9 用HpageBreaks、VPageBreaks屬性計算列印頁數
Sub 計算頁數()
Dim r As Long, c As Long, p As Long
Dim ws1 As Worksheet
Set ws1 = ActiveSheet
c = ws1.HPageBreaks.Count + 1
r = ws1.VPageBreaks.Count + 1
p = r * c
MsgBox "當前工作表共有" & p & "頁。 "
End Sub
2.10 用Shapes屬性控制工作表中的圖片
Sub 刪除圖片()
Dim p As Shape
For Each p In ActiveSheet.Shapes
If p.Type = msoPicture Then p.Delete
Next
End Sub
2.11 用Hyperlinks集合處理超連結
Sub 添加超連結()
Dim i As Integer
With ActiveSheet
For i = 1 To Worksheets.Count - 1
.Cells(i + 2, 2).Value = Worksheets(i + 1).Name
.Hyperlinks.Add anchor:=Cells(i + 2, 2), _
Address:="", SubAddress:=Cells(i + 2, 2).Value & "!a1", _
TextToDisplay:=Cells(i + 2, 2).Value
Next
End With
End Sub
Sub 刪除超連結()
Dim h As Hyperlink, hs As Hyperlinks
Set hs = ActiveSheet.Hyperlinks
For Each h In hs
h.Delete
Next
End Sub
2.12 自訂函數判斷工作表是否存在
Function WorksheetExists(ByVal SheetName As String) As Boolean
Dim sName As String
On Error GoTo err1
sName = Worksheets(SheetName).Name
WorksheetExists = True
Exit Function
err1:
WorksheetExists = False
End Function
3 回應用戶操作3.1 用SelectionChange事件禁止選中某個區域
例如，
以下代碼將禁止用戶選擇B1:F3儲存格區域：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Long, c As Long
r = Target.Row
c = Target.Column
If r <= 3 And c >= 2 And c <= 6 Then [B4].Select
End Sub
3.2 用ScrollArea屬性設置滾動區域
例如，
如下代碼限制用戶只能選擇A－E列中的儲存格
Private Sub Worksheet_Activate()
ActiveSheet.ScrollArea = "A1:E1048576"
End Sub
3.3 用countif函數禁止輸入相同資料
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 2 Then
If Target.Value <> "" And WorksheetFunction.CountIf(Columns(2), Target.Value) > 1 Then
MsgBox "請不要輸入相同的資料！"
Application.Undo
End If
End If
Application.EnableEvents = True
End Sub
3.4 用SelectionChange事件輸入連續的資料
例如， 以下代碼就可以限制用戶的選擇只能是A列中有內容的儲存格或其後一個儲存格
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
i = ActiveSheet.Range("A65536").End(xlUp).Row
j = Target.Column
If Target.Row > i Then
Cells(i + 1, j).Select
End If
End Sub
3.5 用BeforeRightClick事件增加快顯功能表
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
For Each mnu1 In Application.CommandBars("cell").Controls
If mnu1.Tag = "MyMenu" Then mnu1.Delete
Next
If Not Application.Intersect(Target, Range("A1:C10")) Is Nothing Then
With Application.CommandBars("cell").Controls.Add _
(Type:=msoControlButton, before:=6, temporary:=True)
.Caption = "測試命令"
.OnAction = "顯示測試資訊"
.Tag = "MyMenu"
End With
End If
End Sub
在模組中保存以下過程
Sub 顯示測試資訊()
MsgBox "你選擇了用戶添加的快顯功能表！" & _
vbCrLf & "本例為測試代碼， 未編寫具體的功能。 "
End Sub
3.6 用Deactivate事件限制選擇其他工作表
Private Sub Worksheet_Deactivate()
ActiveSheet.Activate
MsgBox "您無權操作其他工作表， 只能在“Sheet1”工作表中進行操作！", _
vbCritical + vbOKOnly, "警告"
End Sub
3.7 用Activate事件隱藏工作表
Private Sub Worksheet_Activate()
Dim ws As Worksheet
For Each ws In Worksheets '迴圈隱藏每個工作表
If ws.Name <> "主介面" Then ws.Visible = False
Next
End Sub
Sub 顯示工作表()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Visible = xlSheetVisible
Next
End Sub
3.8 用Interior屬性突出顯示當前位置
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer
On Error Resume Next
i = Target.Interior.ColorIndex
If i < 0 Then
i = 36
Else
i = i + 1
End If
If iColor = Target.Font.ColorIndex Then '避免字體顏色與突出色相同
i = i + 1
End If
Cells.Interior.ColorIndex = xlColorIndexNone
Rows(Target.Row).Interior.ColorIndex = i
Columns(Target.Column).Interior.ColorIndex = i
End Sub