Excle VBA常用技巧 第02章 Worksheet对象

VBA常用技巧代码解析

#006 For i = 0 To UBound(arr) #007 With Worksheets

#008 Set sh = .Add(after:=Sheets(.Count)) #009 sh.Name = arr(i) #010 End With #011 Next

#012 Application.DisplayAlerts = False #013 For Each sh In Worksheets

#014 If sh.Name Like \#015 Next

#016 Application.DisplayAlerts = True #017 End Sub

代码解析：

Addsh_5过程使用Add方法在工作簿中添加10张工作表并重新命名为1到10，如果工作簿中已有相同名称的工作表则不添加。

第4行代码错误处理语句，当发生重名错误时忽略错误，继续添加工作表。

第5行到第11行代码在工作簿中添加10张工作表并重新命名为1到10，如果工作簿中已有相同名称的工作表则忽略错误重命名时发生的错误，此时工作簿中添加的工作表会以系统赋与的名称命名，如“Sheet1”。

第12行到第15行代码使用For Each...Next语句遍历工作簿中所有的工作表，将工作簿中凡是以“Sheet”开头的工作表删除。

技巧6 禁止删除指定工作表

在工作表事件中是没有工作表删除事件的，为了防止用户误删除重要的工作表，除了使用保护工作簿方法外，还可以使用下面的代码。

#001 Public Ctl As CommandBarControl #002 Sub DelSht()

#003 Set Ctl = Application.CommandBars.FindControl(ID:=847)

13

VBA常用技巧代码解析

#004 Ctl.OnAction = \#005 End Sub #006 Sub ResSht()

#007 Set Ctl = Application.CommandBars.FindControl(ID:=847) #008 Ctl.OnAction = \#009 End Sub

#010 Sub MyDelSht()

#011 If VBA.UCase$(ActiveSheet.CodeName) = \#012 MsgBox \禁止删除\工作表!\#013 Else

#014 ActiveSheet.Delete #015 End If #016 End Sub

代码解析：

DelSht过程将工作表标签右键菜单中的“删除工作表”菜单的OnAction属性设置为“MyDelSht”。

第3行代码使用Set语句将工作表标签右键菜单中的“删除工作表”菜单赋给变量Ctl，并将其OnAction属性设置为MyDelSht过程，该菜单被单击时将运行“MyDelSht”过程而不是系统默认的设置。OnAction属性返回或设置一个VBA的过程名，该过程在用户单击或更改某命令栏控件的值时运行。

ResSht过程将工作表标签右键菜单中的“删除工作表”菜单的OnAction属性恢复为默认设置。

MyDelSht过程判断所要删除的工作表的代码名称是否是“SHEET2”，如果是则禁止删除该表而只显示一个提示消息框。

为了不影响其他工作簿的使用，在VBE中双击ThisWorkbook写入下面的代码。

#001 Private Sub Workbook_Activate() #002 Call DelSht #003 End Sub

#004 Private Sub Workbook_Deactivate() #005 Call ResSht #006 End Sub

代码解析：

工作簿的Activate事件和Deactivate事件代码，在工作簿激活时运行DelSht过程，在

14

VBA常用技巧代码解析

关闭或打开其他工作簿时运行ResSht过程，这样只禁止删除本工作簿中“SHEET2”工作表，并不影响其他工作簿。

当删除本工作簿中的“SHEET2”工作表时，并不会显示如图 6-1所示的消息框，而只会显示如图 6-2所示的禁止删除工作表的消息框。

图 6-1 删除工作表提示

图 6-2 禁止删除工作表

技巧7 自动建立工作表目录

如果在工作簿中有许多工作表，使用时往往会建立一张目录表并插入超链接以方便选择工作表。但是如果工作簿中的工作表经常添加和删除，使用手工建立目录很不方便，此时可以使用工作表的Activate事件自动建立工作表的目录，如下面的代码所示。

#001 Private Sub Worksheet_Activate() #002 Dim sh As Worksheet #003 Dim a As Integer #004 Dim R As Integer

#005 R = Sheet1.[A65536].End(xlUp).Row #006 a = 2

#007 If Sheet1.Cells(2, 1) <> \

#008 Sheet1.Range(\#009 End If

15

VBA常用技巧代码解析

#010 For Each sh In Worksheets

#011 If sh.CodeName <> \#012 Sheet1.Cells(a, 1).Value = sh.Name #013 a = a + 1 #014 End If #015 Next #016 End Sub

代码解析：

工作表的Activate事件，在“目录”工作表激活时自动建立工作簿中除“目录”工作表外所有工作表的目录。

第2、3、4行代码声明变量类型。

第5行代码取得A列最后非空单元格的行号。

第6行代码设置变量a的初始值为2，从A2单元格开始建立工作表目录。

第7行到第9行代码判断是否存在工作表目录，如果存在先清空原来的目录，以便更新目录。

第10行到第15代码遍历工作簿的所有工作表，将除“目录”工作表外所有工作表的名称写入到A列单元格中。

为了建立到各工作表的链接，使用工作表的SelectionChange事件，如下面的代码所示。

#001 Private Sub Worksheet_SelectionChange(ByVal Target As Range) #002 Dim R As Integer

#003 R = Sheet1.[A65500].End(xlUp).Row #004 On Error Resume Next #005 If Target.Count = 1 Then #006 If Target.Column = 1 Then

#007 If Target.Row > 1 And Target.Row <= R Then #008 Sheets(Target.Value).Select #009 End If #010 End If #011 End If #012 End Sub

代码解析：

16