Worksheet对象表示Excel工作表，可通过Workbooks集合对象和Worksheet对象的属性、方法和事件对工作表进行操作和管理。

1 使用工作表集合对象Worksheets管理工作表

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