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屬性得到工作表數(shù)量
Sub 工作表數(shù)量()
Dim i As Long
i = Worksheets.Count
MsgBox '當前工作簿的工作表數(shù)為:' & 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屬性獲取工作表保護狀態(tài)
Sub 工作表保護狀態(tài)()
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屬性計算打印頁數(shù)
Sub 計算頁數(shù)()
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 自定義函數(shù)判斷工作表是否存在
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事件禁止選中某個區(qū)域
例如,以下代碼將禁止用戶選擇B1:F3單元格區(qū)域:
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="">=>
End Sub
=>
3.2 用ScrollArea屬性設置滾動區(qū)域
例如,,如下代碼限制用戶只能選擇A-E列中的單元格
Private Sub Worksheet_Activate()
ActiveSheet.ScrollArea = 'A1:E1048576'
End Sub
3.3 用countif函數(shù)禁止輸入相同數(shù)據(jù)
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 '請不要輸入相同的數(shù)據(jù),!'
Application.Undo
End If
End If
Application.EnableEvents = True
End Sub
3.4 用SelectionChange事件輸入連續(xù)的數(shù)據(jù)
例如,以下代碼就可以限制用戶的選擇只能是A列中有內(nèi)容的單元格或其后一個單元格
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 '您無權(quán)操作其他工作表,,只能在“Sheet1”工作表中進行操作,!', _
vbCritical + vbOKOnly, '警告'
End Sub
3.7 用Activate事件隱藏工作表
Private Sub Worksheet_Activate()
Dim ws As Worksheet
For Each ws In Worksheets '循環(huán)隱藏每個工作表
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="">
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