第一章 Range （单元格）对象

1. 单元格的引用方法

1.1 使用Range 属性

语法如下：

Range(Cell1,Cell2)

• 参数Cell1 是必需的，可包括区域操作符（冒号）、相交区域操作符（空格）或者合并区域操作符（逗号），也可以包括美元符号（即绝对地址，如“$A$1”）
• 可在区域中任一部分使用局部定义名称如Range(“B2:LastCell”) ，其中LastCell 为已定义的单元格区域名称。
• 参数Cell2 是可选的

应用示例：

Sub RngSelect()Sheet1.Range("A3:F6,B1:C5").Select
End Sub 

RngSelect 过程使用Select 方法选中A3:F6，B1:C5 单元格区域。运行结果如下：

1.2 使用Cells 属性

语法如下：

Cells(RowIndex,ColumnIndex)

• 参数RowIndex 是可选的，表示引用区域中的行序号。
• 参数 ColumnIndex 是可选的，表示引用区域中的列序号。
• 如果缺参数，Cells 属性返回引用对象的所有单元格。
• Cells 属性的参数可以使用变量，因此经常应用于在单元格区域中循环

应用示例：
Cell 过程使用For Next 语句为工作表中的A1：A100 单元格区域填入序号。

Sub Cell()Dim icell As IntegerFor icell = 1 To 100Sheet1.Cells(icell, 1).Value = icellNext
End Sub

1.3 使用快捷记号

在VBA 中可以将A1 引用样式或命名区域名称使用方括号括起来，作为Range 属性的快捷方式，这样就不必键入单词“Range” 或使用引号
注意：使用快捷记号引用单元格区域时只能使用固定字符串而不能使用变量。
应用示例：
Fastmrk 过程使用快捷记号为单元格赋值
第2行代码使用快捷记号将活动工作表中的A1：A5 单元格赋值为2
第三行代码将工作簿中已命名为“Fast” 的单元格区域赋值为4

Sub Fastmark()[A1:A5] = 2 [Fast] = 4
End Sub

运行结果如下：

1.4 使用Offset 属性

语法如下：

expression.Offset(RowOffset, ColumnOffset)

• 参数expression 是必需的，该表达式返回一个Range 对象。
• 参数RowOffset 是可选的，区域偏移的行数（正值、负值或0（零））。正值表示向下偏移，负值表示向上偏移，默认值是0
• 参数Coulmnoffset 是可选的，区域偏移的列数（正值、负值或0（零））。正值表示向右偏移，负值表示想左偏移，默认值是0

应用示例：

Sub Offset()sheet1.range("A1:C3").Offset(3,3).select
End Sub

1.5 使用Resizae 属性

基本语法：

expression.Resize(RowSize,columnSize)

• 参数expression 是必需的，返回要调整大小的Range 对象
• 参数RowSize 是可选的，新区域中的行数。如果省略该参数，则区域中的行数保持不变。
• 参数ColumnSize 是可选的，新区域中的列数。如果省略该参数。则区域总的列数保持不变

应用示例：
将选中的A1 单元格扩展三行三列的区域。

Sub Resize ()sheet1.Range("A1").Resize(3,3).select
End Sub

1.6 使用Union 方法

1. 用法
   使用Union 方法可以将多个非连续区域连接起来成为一个区域，从而可以实现对多个非连续区域一起进行操作

2. 基本语法：

expression.Union(Arg1,Arg2,……)

• 参数expression 是可选的，返回一个Application 对象。
• 参数Arg1,Arg2 ……是必需的，至少指定两个Range 对象。

3. 应用示例：

Sub UnSelect()Union(Sheet1.Range("A1:D4"),Sheet1.Range("E5:H8")).Select
End Sub

1.7 使用UsedRange 属性

1. 用法
返回指定工作表上已使用单元格组成的区域

2. 应用示例

Sub UseSelect()Sheet1.UsedRange.Select 
End Sub

运行结果：

1.8 使用CurrentRegion 属性

1. 用法
返回指定工作表上当前单元格所在的连续区域。

2. 应用示例

Sub CurrentSelect()Sheet1.Range("A5").CurrentRegion.Select 
End Sub 

运行结果：

2. 选定单元格区域的方法

2.1 使用Select 方法

1. 用法
选定单元格或者单元格区域
2. 基本语法

expression.select(replace)

• 参数 expression 是必需的，一个有效的对象
• 参数 Replace 是可选的，要替换的对象
• 使用Select 方法选定单元格时，单元格所在的工作表必需为活动工作表，所以在使用前要用Activate 方法使称为活动工作表

3. 应用示例

Sub RngSelect()Sheet1.Activate Sheet1 .Range("A1:B10").Select
End Sub 

2.2 使用Activate 方法

1. 用法
选定单元格或单元格区域
2. 基本语法

expression.Activate

• 使用Activate 方法时，单元格所在的工作表也必需为活动工作表

3. 应用示例

Sub RngActivate()Sheet1.ActivateSheet1.Range("A1:B10").Activate
End Sub

2.3 使用Goto 方法

1. 用法
使用Goto 方法无需使工作表是当前活动工作表
2. 基本语法

expression.Goto(Refrence,Scrol1)

• 参数 expression 是必需的，返回一个Application 对象
• 参数 Reference是可选的，Variant 类型，指定目标。可以是Range 对象、包括R1C1样式记号的单元格引用的字符串或包含VB 过程名的字符串。如果省略该参数，目标将是最近一次用Goto 方法选定的区域。
• 参数Scroll 是可选的，Variant 类型，如果该值为True，则滚动窗口直至目标区域的左上角单元格出现在窗口的左上角。如果该值为False ,则不滚动窗口。默认值为False

3. 应用示例

Sub RngGoto()Application.Goto Reference:= Sheet1.Range("A1:B10"),Scroll:= True
End Sub

3. 获得指定行、列中的最后一个非空单元格

1. 用法
在使用VBA 对工作表进行操作时，经常需要定位到指定行货列中最后一个非空单元格，此时可以使用Range 对象的End 属性，在取得单元格对象后便能获得该单元格的相关属性，如单元格地址、行列号、数值等

2. 基本语法

expression.End(Direction)

• 参数 expression 是必需的，一个有效的对象
• 参数 Direction 是可选的，所要移动的方向，可以为以下所示的XlDirection 常量之一

常量	值	描述
xlDown	-4121	向下
xlUp	-4162	向上
xlToLeft	-4159	向左
xlToRight	-4161	向右

3. 应用示例
① 查找A列最后一个非空单元格

Sub LastRow()Dim rng as rangeset rng = sheet1.range("A65536").End(xlup)msgbox("A列中最后一个非空单元格是" & rng.address(0,0)& ",行号" & rng.row & ",数值" & rng.value )set rng = nothingEnd Sub

② 查找第一行最后一个非空单元格

Sub LastColumn()Dim rng as Rangeset rng = sheet1.range("IV1").end(xlToLeft)Msgbox "第一行中最后一个非空单元格是" &rng.Address(0,0) & "，列号" & rng.column & ",数值" & rng.value set rng = nothing  End Sub

4. 定位单元格

1. 用法
在VBA 中使用SpecialCell 方法
2. 基本语法

expression.specialCells (Type,Value)

• 参数 expression 是必需的，返回一个有效的对象
• 参数 Type 是必需的，要包含的单元格，可为下表所列的xlCellType 常量之一

常量	值	描述
xlCellTypeAllFormatConditions	-4172	任意格式单元格
xlCellTypeAllValidation	-4174	含有验证条件的单元格
xlCellTypeBlanks	4	空单元格
xlCellTypeComments	-4144	含有注释的单元格
xlCellTypeConstants	-4172	含有常量的单元格
xlCellTypeFormulas	-4174	含有公式的单元格
xlCellTypeLastCell	4	使用区域中最后的单元格
xlCellTypeSameFormatConditions	-4144	含有相同格式的单元格
xlCellTypeSameValidation	4	含有相同验证条件的单元格
xlCellTypeVisible	12	所有可见单元格

• 参数Value 是可选的，如果Type 参数为 xlCellTypeConstants 或 xlCellTypeFormulas， 此参数可用于确定结果中应包含哪几类单元格。将某几个值相加可使此方法返回多种类型的单元格。如果省略将选定所有常量或公式，可为以下表格所列的 XlSpecialCellsValue常量之一。

常量	值	描述
xlErrors	16	错误
xlLogical	4	逻辑值
xlNumbers	1	数字
xlTextValues	2	文本

3. 应用示例

Sub SpecialAddress()Dim RNG as rangeset RNG = sheet1.usedrange.specialcells(xlcelltypeformulas)rng.selectmsgbox "工作表中有公式的单元格为：" &rng.addressset rng = nothing 
end sub 

5. 查找单元格

5.1 使用Find 方法

1. 用法
在Excel 中使用查找对话框可以查找工作表中特定内容的单元格，而在VBA 中则使用Find 方法
2. 基本语法

expression.find(what,after,lookin,lookat,searchorder,searchdirection,matchcase,matchbyte,serchformat)

• 参数 expression 是必需的，改表达式返回一个Range 对象
• 参数what 是必需的，要搜索的数据，可为字符串或者任意数据类型
• 参数After 是可选的，表示搜索过程将从其之后开始进行的单元格，必需是区域中的单个单元格，查找时是从该单元格之后开始的，直到本方法绕回到指定的单元格时，才对其进行搜索。如果未指定本参数，搜索将从区域的左上角单元格之后开始。
• 参数LookIn 是可选的，信息类型
• 参数LookAt 是可选的，可为XLookaT 常量的xlWhole 或xlPart 之一
• 参数SearchOrder 是可选的，可为xlSearc和Order 常量的xlByRows 或xlByColumns 之一
• 参数SearchDirection 是可选的，搜索的方向，可为xlSeachDirection 常量的xlNext 或xlPrevious 之一
• 参数MatchCase 是可选的，若为True ,则进行区分大小写的查找。默认值为False
• 参数MatchByte 是可选的，仅在选择或安装了双字节语言支持时使用。若为True, 则双字节字符仅匹配双字节字符。若为False ,则双字节字符可匹配其等价的单字节字符
• 参数Serchformat 是可选的，搜索的格式

每次是用Find 方法后，参数的设置将保存。如果下次调用Find 方法时不指定这些参数的值，就使用保存的值。因此每次是用该方法时请明确设置这些参数
如果工作表的A列存在重复的数值，那么需要使用FindNext 方法或 FindpREVIOUS 方法进行重复搜索。

3. 应用示例

Sub RngFind()Dim StrFind As StringDim Rng As RangeStrFind = InputBox("请输入要查找的值:")If Trim(StrFind) <> "" ThenWith Sheet1.Range("A:A")Set Rng = .Find(What:=StrFind, _After:=.Cells(.Cells.Count), _LookIn:=xlValues, _LookAt:=xlWhole, _SearchOrder:=xlByRows, _SearchDirection:=xlNext, _MatchCase:=False)If Not Rng Is Nothing ThenApplication.Goto Rng, TrueElseMsgBox "没有找到该单元格!"End IfEnd WithEnd If
End Sub

代码解析：
RngFind 过程使用Find 方法在工作表Sheet1的A列中查找Inputbox 函数对话框中所输入的值，并查找该值所在的第一个单元格。
第6行到第13行代码在工作表中的A 列中查找特定信息，并返回Rnage 对象，该对象代表用于查找信息的第一个单元格。如果未发现匹配单元格，就返回Nothing

5.3 使用Like 运算符

1. 用法
使用Like 运算符可以进行更为复杂的模式匹配查找
2. 基本语法

result = string like pattern 

• 参数string 是必需的，字符串表达式
• 参数pattern 是必需的，字符串表达式
  如果string 与pattern 匹配，则Result 为True ；如果不匹配，则Result 为FALSE .但是如果string 或 pattern 中有一个为null ，则result 为null
  参数pattern 可以使用通配符、字符串列表或字符串区间的任何自核来匹配字符串。表中列出pattern 中允许的字符以及他们与什么进行匹配。

pattern 中的字符	符合 string 中的字符
？	任何单一字符
*	零个或多个字符
#	任何一个数字（0-9）
charlist]	charlist 中任何单一字符
[!charlist]	不在charlist 中的任何单一字符

6. 替换单元格内字符串 （Replace）

1. 用法
如果需要替换单元格内指定的字符串，那么使用Range 对象的Replace方法
2.基本语法

expression.replace(what,replacement,lookat,searchorder,matchcase,matchbyte,searchformat,replaceformat)

• 参数 expression 是必需的，返回一个range 对象
• 参数what 是必需的，要搜索的字符串
• 参数replacement 是必需的，替换的字符串
• 运行RngReplace 过程前后
  3. 应用示例

Sub RngReplace()Range("A1:A5”").replace "通州","南通"
End Sub 

7. 复制单元格区域

1. 用法
在实际操作中，经常需要复制指定的单元格区域到另一个单元格区域，要复制指定单元格区域到其他位置，使用Range 对象的Copy 方法
2. 基本语法

copy(destination)

• 参数Destination 表示复制单元格区域的目标区域，如果省略该参数，Excel 将把该区域复制到剪贴板中。
• 使用copy 方法复制单元格区域的时候，也复制了该单元格区域的格式
• 复制单元格区域，如果目标区域为非空单元格区域，可以使用Application.DisplayAlerts 属性设为False,使复制时不弹出该消息框。
  3. 应用示例

Sub RangeCopy()Application.DisplayAlerts = FlaseSheet1.Range("A1").CurrentRegion.copy sheet2.range("A1")Application.DisplayAlerts = TrueEnd Sub

如果希望在复制单元格区域的同时，也复制源区域的列宽大小，可以使用下面的代码

Sub CopyWithSameColumnWidths()
sheet1.Range("A1").Currentregion.copy
with sheet3.range("A1").PasteSpecial xlpastecolumnwidths .PasteSpecial xlpasteAll
End With 
Application.cutcopyMode = False 
End Sub 

代码解析：
第4行代码使用Range 对象的PasteSpecial 方法选择性针贴剪切板中的Range 对象的列宽
第5 行代码粘贴剪切板中的Range 对象全部内容
第7行 代码取消应用程序复制模式
应用于Range 对象的PasteSpecial 方法将剪切板中的Range 对象粘贴到指定区域，在粘贴时可以有选择的粘贴对象的部分属性。

PasteSpecial(Paste,Operation,SkipBlanks,Trnaspose)

xlPasteType 常量

常量	值	描述
xlPasteAll	-4104	全部（默认值）
xlPasteAllExceptBorders	7	边框除外
xlPasteColumnWidths	8	列宽
xlPasteComments	-4144	批注
xlPasteFormats	-4122	格式
xlPasteFormulas	-4123	公式
xlPasteFormulasAndNumberFormats	11	公式和数字格式
xlPasteValidation	6	有效性验证
xlPasteValues	-4163	数值
xlPasteValuesAndNumberFormats	12	值和数字格式

xlPasteSpecialOperation 常量

常量	值	描述
xlPasteSpecialOperationNone	-4142	无（默认值）
xlPasteSpecialOperatioADD	2	加
xlPasteSpecialOperationSubtract	3	减
xlPasteSpecialOperationMultiply	4	乘
xlPasteSpecialOperationDivide	5	除

参数SkipBlanks 指示是否跳过空单元格，若参数值为True ，则不将剪切板上区域中的空白单元格粘贴到目标区域中，默认值为False。
参数Transpose 指示是否进行转置，若参数值为True ，则粘贴区域时转置行和列。默认值为False

8. 仅复制数值到另一区域

8.1 使用选择性粘贴

Sub CopyPasteSpecial()Sheet1.Range("A1").CurrentRegion.CopySheet2.Range("A1").PasteSpecial Paste:= xlPasteValuesApplication.CutCopyMode = False	
End Sub

8.2 直接赋值的方法

Sub GetValueResize()With Sheet1.Range("A1").CurrentRegionSheet3.Range("A1").Resize(.Rows.Count, .columns.count).value = .valueend with End Sub

9. 单元格自动进入编辑状态

当光标选择单元格时无需双击，自动进入编辑状态，

Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Target.column = 3 And Target.Count = 1 Then If Target <>"" then Application.SendKeys "{F2}"End IF End If 
End Sub 

10. 禁用单元格拖放功能

在工作表中可以拖放单元格右下角的小十字对单元格内容进行复制等操作，如果不希望用户进行此操作可以禁用单元格拖放功能

Private Sub Worksheet_SelectionChange(ByVal Target as Range)if Not Application.Intersect(Target ,range("A1:A15")) is nothing then Application.celldraganddrop = false else appliction.celldraganddrop = true end if 
end sub

为了不影响其他工作表，应在工作表的Deactive 事件中恢复单元格的拖放功能

Private Sub Worksheet_Deactivate()Application.cellDragAndDrop = true 
End Sub

11. 单元格格式操作

11.1 单元格字体格式设置

Public Sub RngFont()with range("A1").FONT.Name = "华文彩云".FontStyle = "bold".size = 18.colorindex = 3.underline = 2 end with End Sub

调色板中颜色的编号

xlunderStyle 常量

常量	值	描述
xlunderlineStyleNone	-4142	无
xlunderlineStyleSingle	2	单下划线
xlUnderlineStyleDouble	-4119	双下划线
xlUnderlineStyleSingleAccounting	4	会计用单下划线
xlUnderlineStyleDoubleAccounting	5	会计用双下划线

11.2 设置单元格内部格式

设置单元格Interior 属性可以对单元格的内部格式进行设置

Sub RngInterior()with range("A1").iNTERIOR.colorindex = 3 .pattern = xlpatternCrissCross.PatternColorIndex = 6end with End Sub

11.3 为单元格区域添加边框

我们为单元格区域添加边框时往往通过录制宏获取代码，但宏录制器生成的代码分别设置单元格区域的每个边框，因此代码多且效率低。使用Range对象的Borders 集合可以快速对单元格区域的每个边框应用相同的格式，而Range 对象的BorderAround 方法则可以快速的为单元格区域添加一个外边框
基本语法:

BorderAround(LineStyle,Weight,ColorIndex,Color )

• 参数LineStyle 参数设置边框线条的样式，weight 参数设置线条的粗细，colorindex 设置边框颜色，color 参数以RGB 值指定边框的颜色
• 注意： 指定color 参数可以设置颜色为当前调色板之外的其他颜色，不能同时指定colorindex 参数和color参数。

Sub AddBorders()
dim rng as range 
set rng  = range ("B4:G10")
with rng.borders 
.linestyle = xlcontinuous 
.weight = xlthin 
.colorindex = 5
end with 
rng.borderaround xlcontinuous ,xlmedium,5
set rng = nothing
End Sub

xlBordersIndex 常量

常量	值	描述
xlDiagonalDown	5	斜下边框
xlDiagonalUp	6	斜上边框
xlEdgeBottom	9	底部边框
xlEdgeLeft	7	左边框
xlEdgeRight	10	右边框
xlEdgeTop	8	顶部边框
xlInsideHorizontal	12	内部水平
xlInsideVertical	11	内部垂直

11.4 灵活设置单元格的行高列宽

基本语法：

expression.centimeterstopoints (centimeters)

• 参数expression 是必需的，返回一个Application 对象
• 参数centimeters 是必需的，指定要转换为磅值的厘米值

expression.InchesToPoints(Inches)

• 参数expression 是必需的，返回一个Application 对象
• 参数Inches 是必需的，指定要转换为磅值的英寸值

Sub RngToPoint()with range("A1").RowHeight = Application.centimetersToPoints(2).ColumnWidth= Application.centimetersToPoints(1.5)end withwith range("A2").RowHeight = Application.InchesToPoints(1.2).columnwidth = application.InchesToPoints(0.3)end with 
end sub 

12. 单元格中的数据有效性

12.1 在单元格中建立数据有效性

基本语法：

expression.add (Type,AlterStyle,Operation,Formula1,Formula2)

• 参数 expression 是必需的，返回一个Validation 对象
• 参数Type 是必需的，数据有效性类型
• 参数AlertStyl 是可选的，有效性检验警告样式
• 参数Operator 是可选的，数据有效性运算符
• 参数Formula1 是可选的，数据有效性公式的第一部分
• 参数Formula2 是可选的，当Operator 为xlBetween 或xlNotBetween 时，数据有效性公式的第二部分

Sub Validation()
with range("A1:A10").validation
.delete 
.add type := xlvalidatelist,alertstyle := xlvalidalertstop ,operator:= xlbetween ,formula1:= "1,2,3,4,5,6,7,8"
end with 
End Sub

数据有效性类型

数据有效性类型	参数
xlValidateCustom	Formula1 必需，忽略Formula2 ，formula1 必需包含一个表达式，数据项有效时该表达式取值为True ,而数据项无效时取值为False
xlInputOnly	能使用AlertStyle、Formula1 或Formula2 参数
xlValidateList	Formula1 必需，忽略Formula2 。Formula1 必须包含以逗号分隔的取值列表，或引用此列表的工作表
xlValidateWholeNumber\xlValidateDate\xlValidateDecimal\xlValidateTextLength\xlValidTime	必须指定Formula1 或Formula2 之一，或两者均指定

数据有效性类型

12.2 判断单元格是否存在数据有效性

Sub Validation()On Error Goto line if range("A2").Validation.Type>= 0 then msgbox "单元格有数据有效性！"exit sub end if line:msgbox "单元格没有数据有效性！"
End Sub

12.3 动态的数据有效性

Private Sub Worksheet_SelectionChange(byVal Target as range)
If Target.column = 1 and Target.count = 1 and Target.row > 1 then 
with Target.validation
.delete 
.add type := xlvalidateList, _
alertstyle := xlValidAlertStop, _
Operator := xlBetween, _
Formula1 := "主机，显示器"
end with
end if
End SubPrivate Sub Worksheet_change (ByVal Target as range)
if target.column = 1 and target.row > 1 and target.count = 1 then 
with target.offset(0,1) .validation
.delete
select case target
case "主机"
.add Type := xlvalidatelist, _
alertStyle := xlValidAlertStop, _
Operator:= xlBetween, _ 
Formula1 := "z286,z286,z486,z586"
case "显示器"
.add Type:= xlValidatelist, _
alertstyle := xlvalidalertsyop,_
operator:= xlBetween,_
Formula1 := "三星17，飞利浦15，三星15"End Select
End With 
End If 
End Sub 

12.4 自动展开数据有效性下拉列表

基本语法

expression.SendKeys (Keys,wait)

• 参数 expression 是可选的，该表达式返回一个Application 对象
• 参数Keys 是必需的，要发送的键或组合键，以文本方式表示

Keys 参数可以指定任何单个键或与Alt/Ctrl/Shift 的组合键（或者这些键的组合）
每个键可用一个或多个字符表示。例如，“”a“表示字符a ,或者“”{ENTER}" 表示Enter。
若要指定在相应键时不会显示的字符（例如，Enter 或 Tab ）,请使用下表所列代码来表示相应的键

键	代码
Backspace	{BACKSPACE} 或 {BS}
Break	{Break}
Caps Lock	{CAPSLOCK}
Clear	{CLEAR}
Delete 或 Del	{DELETE} 或{DEL}
End	{END}
Enter	~ （波形符）
Enter（数字小键盘）	{ENTER}
Esc	{ESCAPE} 或 {ESC}
F1 到 F15	{F1} 到 {F15}
Help	{HELP}
Home	{HOME}
Ins	{INSERT}
Num Lock	{NUMLOCK}
Page Down	{PGDN}
Page Up	{PGUP}
Return	{RETURN}
Scroll Lock	{SCROLLLOCK}
Tab	{TAB}
向上键	{UP}
向下键	{DOWN}
向右键	{RIGHT}
向左键	{LEFT}

13. 单元格中的公式

1. 用法
使用Range 对象的Formula 属性可以在单元格区域中写入公式
2. 基本语法

expression.Formula

• 参数expression 是必需的，返回一个Range 对象

3. 应用示例

Sub Formula()Sheet1.Range("C1:C10").Formula = "=sum(A1+B1)"
End Sub 

还可以使用FormulaR1C1 属性返回或设置以R1C1 样式符号表示的公式
如下代码所示

Sub RngFormulaRC()Sheet2.Range("C1:C10").FormulaR1C1 = "=SUM(RC[-2] + RC[-1])"
End Sub

14. 单元格中的批注

14.1 判断单元格是否存在批注

在VBA 中，可以利用Range 对象的Comment 属性判断单元格是否存在批注，如下面的代码所示。

Sub HasComment()If Range("A1").Comment Is Nothing ThenMsgBox "A1单元格中没有批注!"ElseMsgBox "A1单元格中批注内容为：" & Chr(13) & Range("A1").Comment.TextEnd IfEnd Sub

代码解析：
HasComment 过程判断A1 单元格是否存在批注，并用消息框显示批注信息。
Range 对象的Comment 属性返回一个批注对象，如果指定的单元格不存在批注，该属性返回Nothing。
运行HasComment 过程结果如图 所示。

14.2 为单元格添加批注

如果希望为单元格添加批注，那么可以使用AddComment 方法，如下面的代码所示。

  Sub Comment_Add()With Range("A1")If .Comment Is Nothing Then.AddComment Text:="hello".Comment.Visible = TrueEnd IfEnd WithEnd Sub

代码解析：
Comment_Add 判断单元格A1 中是否存在批注，如果没有批注则为单元格A1 添加批注并将单元格数值作为批注文本，同时显示批注对象。
第4行代码使用Range对象的AddComment 方法为单元格添加批注。该方法只有一个参数Text，代表批注文本。如果单元格已经存在批注，则该方法返回一个错误。
第5行代码显示批注对象，Visible属性确定对象是否可视。
当单元格A1中不存在批注时，运行代码后的结果如图所示。

14.3 删除单元格中的批注

如果需要删除单元格中的批注，那么可以使用ClearComments 方法、ClearNotes 方法或者Delete 方法，如下面的代码所示。

Sub Commentdel()On Error Resume NextRange("A1").ClearCommentsRange("A2").ClearNotesRange("A3").Comment.Delete
End Sub

代码解析：
Notesdel过程删除单元格中的批注。
第2行代码错误处理语句，如果单元格中没有批注，那么运行第5行代码时会发生错误，所以使用On Error 语句来忽略错误
第3行代码使用ClearComments 方法删除单元格A1中的批注。ClearComments方法清除指定区域的所有单元格批注，语法如下：

expression.ClearComments

第4行代码使用ClearNotes方法删除A2单元格中的批注。ClearNotes方法清除指定区域中所有单元格的附注和语音批注，语法如下：

expression.ClearNotes

第5行代码使用Delete方法删除删除A3单元格中的批注.Range 对象的Comment 属性返回一个Comment 对象，该对象代表与该区域左上角单元格相关联的批注。

15. 合并单元格操作

15.1 判断单元格区域是否存在合并单元格

Range 对象的MergeCells 属性可以确定单元格区域是否包含合并单元格，如果该属性返回值为True，则表示区域包含合并单元格。
下面的代码判断单元格 A1是否包含合并单元格，并显示相应的提示信息。

Sub IsMergeCell()If Range("A1").MergeCells = True ThenMsgBox "包含合并单元格"ElseMsgBox "没有包含合并单元格"End If
End Sub

如果在指定区域中存在部分合并的单元格，区域E8:I17中包含合并单元格区域F8:G9，H12:I13。判断这样一个单元格区域中是否包含合并单元格，可以使用下面的代码快速判断单元格区域中是否包含部分合并单元格，而不需要遍历单元格。

Sub IsMerge()If IsNull(Range("E8:I17").MergeCells) ThenMsgBox "包含合并单元格"ElseMsgBox "没有包含合并单元格"End If
End Sub

代码解析：
当单元格区域中同时包含合并单元格和非合并单元格时，MergeCells属性将返回Null，因此第2行代码通过该返回结果作为判断条件。
运行IsMerge过程结果如图所示。

15.2 合并单元格时连接每个单元格的文本

使用Excel 的“合并及居中”按钮合并多个单元格区域时，Excel仅保留区域左上角单元格的内容，如果用户希望在合并如下图所示单元格区域时，将各个单元格的内容连接起来保存在合并后的单元格区域中，则可以使用下面的代码。

Sub Mergerng()Dim StrMerge As StringDim rng As RangeIf TypeName(Selection) = "range" Then   ' 这里需要定义合并区域的名称For Each rng In SelectionStrMerge = StrMerge & rng.ValueNextApplication.DisplayAlerts = FalseSelection.MergeSelection.Value = StrMergeApplication.DisplayAlerts = TrueEnd If
End Sub

代码解析：
Mergerng 过程将所选各个单元格的内容连接起来保存在合并后的单元格区域中。
第4行代码使用TypeName函数判断当前选定对象是否为Range对象，若是则继续执行代码。
第5行到第7行代码将当前选中区域的内容连接起来保存在字符串变量StrMerge中。
第8行代码将DisplayAlerts属性设置为False，禁止在合并多重数值区域时，Excel显示的警告信息，如图所示，以避免中断代码的运行。

第9行代码使用Merge方法合并当前选定区域。应用于Range对象的Merge方法通过指定Range对象创建合并单元格，语法如下：

expression.Merge(Across)

• 参数expression是必需的，返回一个Range对象。
• 参数Across是可选的，如果该值为True，则将指定区域内的每一行合并为一个合并单元格。默认值为False。
  第9行也可以使用下面的代码：
  Selection.MergeCells = True
  第10行代码将变量StrMerge的值赋给合并后的单元格。
  运行Mergerng过程结果如图所示。
  

15.3 合并内容相同的连续单元格

如果需要合并如图 15 6所示的工作表中B列中部门相同的连续单元格，可以使用下面的代码。

图 15 6 需合并的工作表

Sub Mergerng()Dim IntRow As IntegerDim i As IntegerApplication.DisplayAlerts = FalseWith Sheet1IntRow = .Range("A65536").End(xlUp).RowFor i = IntRow To 2 Step -1If .Cells(i, 2).Value = .Cells(i - 1, 2).Value Then.Range(.Cells(i - 1, 2), .Cells(i, 2)).MergeEnd IfNextEnd WithApplication.DisplayAlerts = True
End Sub

代码解析：
第7行到第11行代码，从最后一行开始，向上逐个单元格判断连续两个单元格的内容是否相同，如果相同则合并。
运行Mergerng过程后，结果如图 15 7所示。

15.4 取消合并单元格时在每个单元格中保留内容

如果需要取消如图 15 7所示的工作表中B列“部门”的合并单元格，并且各个单元格均保留原合并单元格的内容，可以使用下面的代码。

Sub UnMerge()Dim StrMer As StringDim IntCot As IntegerDim i As IntegerWith Sheet1For i = 2 To .Range("B65536").End(xlUp).RowStrMer = .Cells(i, 2).ValueIntCot = .Cells(i, 2).MergeArea.Count.Cells(i, 2).UnMerge.Range(.Cells(i, 2), .Cells(i + IntCot - 1, 2)).Value = StrMeri = i + IntCot - 1NextEnd With
End Sub

代码解析：
UnMerge过程取消工作表中B列中的合并单元格，并且各个单元格均保留原合并单元格的内容。
第7行代码取得B列每个合并单元格的内容。
第8行代码取得合并区域的单元格数量。
第9行代码使用UnMerge方法取消合并单元格。UnMerge方法将合并区域分解为独立的单元格，语法如下：

expression.UnMerge

第10行代码将原合并单元格的内容赋值给取消合并单元格后的区域。
第11行代码调整循环变量i的值，使下一次循环从下一个单元格区域开始。
运行UnMerge过程结果如图 15 6所示。

16. 高亮显示单元格区域

如果希望以某种方式突出显示活动单元格或者指定的单元格区域，从而一目了然地获得某些信息，那么可以高亮显示活动单元格区域，如下面的代码所示。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)Cells.Interior.ColorIndex = xlColorIndexNoneTarget.Interior.ColorIndex = 8
End Sub

代码解析：
设置工作表当前选定区域单元格的内部填充颜色，以高亮显示选定区域，如图 16 1所示。

图 16 1 高亮显示选定区域
第2行代码将工作表中所有的单元格的内部填充颜色设置为xlColorIndexNone，即取消单元格的内部填充颜色。
第3行代码将工作表中选定单元格的内部填充颜色设置为8。
应用于Interior对象的ColorIndex属性返回或设置边框内部的颜色。该颜色可指定为当前调色板中颜色的编号（请参阅技巧11-1中的图 11 1）或为 XlColorIndex 常量之一：xlColorIndexAutomatic（指定对图形对象自动填充）、xlColorIndexNone（用于指定无内部填充）。
还可以高亮显示指定区域内的行列，如下面的代码所示。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)Dim rng As RangeCells.Interior.ColorIndex = xlNoneSet rng = Application.Union(Target.EntireColumn, Target.EntireRow)rng.Interior.ColorIndex = 24
End Sub

代码解析：
设置工作表当前选定区域单元格内部填充颜色，高亮显示活动单元格所在的行列，如图 16 2所示。
第4行代码使用Union方法将所选单元格所在的行、列连接起来成为一个区域，关于Union方法请参阅技巧1-6。

图 16 2 高亮显示活动单元格所在的行列
注意 使用此方法时，工作表中所有设置的单元格内部填充颜色将会被清除。（不包括通过条件格式设置的单元格内部填充颜色），同时无法在工作表中实现复制粘贴功能。

17. 双击被保护单元格时不显示提示消息框

当用户使用鼠标左键双击被保护工作表中锁定的单元格区域时，系统将显示如图 17 1所示的消息框。

图 17 1 系统提示消息框
如果不希望显示该消息框，可以在工作表Worksheet_BeforeDoubleClick事件中进行设置，如下面的代码所示。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Target.Locked = True ThenMsgBox "此单元格已保护，不能编辑!"Cancel = TrueEnd If
End Sub

代码解析：
当用户使用鼠标左键双击工作表单元格时，触发Worksheet_BeforeDoubleClick事件。该事件中的Target参数代表用户双击鼠标左键的单元格区域。
参数Cancel设置是否取消该操作。如果将参数Cancel设置为True，将不进行默认的双击操作。
第2行代码中判断用户双击鼠标左键的单元格区域是否已锁定（Range对象的Locked属性返回或设置Range对象是否锁定），如果单元格区域已锁定，则设置参数Cancel设置为True，不进行默认的双击操作，因而不再显示图 17 1所示的消息框，只显示一个自定义的提示信息，如图 17 2所示。

图 17 2 自定义提示信息

18. 重新计算工作表指定区域

如果在工作表中含有大量公式，那么在对工作表执行重新计算操作时，可能需要较长的时间。在实际工作中，有时希望仅对指定的区域进行重新计算，以提高计算效率，那么可以使用下面的代码。

Sub CalculationSpecialRange()Dim OldCalculation As XlCalculationOldCalculation = Application.CalculationApplication.Calculation = xlCalculationManualActiveSheet.Range("A1:D10").CalculateApplication.Calculation = OldCalculation
End Sub

代码解析：
CalculationSpecialRange过程对单元格A1到B10区域进行重新计算。
第3行代码保存当前应用程序的Calculation属性设置。应用于Application对象的Calculation属性返回或设置当前应用程序的计算模式，可为表格 18 1所示的XlCalculation常量之一。

常量	值	含义
xlCalculationAutomatic	-4105	自动计算
xlCalculationManual	-4135	手动计算
xlCalculationSemiautomatic	2	除模拟运算表外自动计算

第4行代码将计算模式设置为手动重算。
第5行代码重新计算活动工作表指定的单元格区域B3:D7。（指定区域之外的公式将不重新计算，但包含易失性函数的公式除外）
第6行代码恢复当前应用程序的Calculation属性设置。

19. 录入数据后单元格自动保护

下面的代码可以使用户在单元格录入数据后自动对已录入数据单元格进行保护,防止修改数据。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)On Error Resume NextSheet1.Unprotect Password:="12345"If Target.Value <> "" ThenTarget.Locked = TrueSheet1.Protect Password:="12345"End If
End Sub

代码解析：
工作表的SelectionChange事件，在单元格录入数据后自动对已录入数据单元格进行保护。
第3行代码使用Unprotect方法取消工作表的保护。应用于Worksheet 对象的Unprotect方法取消工作表的保护，如果工作表不是受保护的，则此方法不起作用，语法如下：

expression.Unprotect(Password)

• 参数expression：必需的，该表达式返回一个Worksheet 对象。
• 参数Password：可选的，指定用于解除工作表的保护的密码，此密码是区分大小写的。
  第4、5行代码单元格录入数据后将Locked属性设置为True。Locked属性应用于Range对象时，如果Range对象被锁定，则该值为True，当工作表有保护时Range对象不可被修改。
  第6行代码使用Protect方法保护工作表。应用于Worksheet对象的Protect方法保护工作表使其不至被修改，语法如下：

expression.Protect(Password, DrawingObjects, Contents, Scenarios, UserInterfaceOnly, AllowFormattingCells, AllowFormattingColumns, AllowFormattingRows, AllowInsertingColumns, AllowInsertingRows, AllowInsertingHyperlinks, AllowDeletingColumns, AllowDeletingRows, AllowSorting, AllowFiltering, AllowUsingPivotTables) 

• 参数expression：必需的，该表达式返回一个Worksheet对象。
• 参数Password：可选的，为一个字符串，该字符串为工作表指定区分大小写的密码。
  其他参数都是可选参数，其功能等同于如图 19 1所示的工作表保护对话框中的各项选项，具体请参阅VBA帮助。

图 19 1 工作表保护对话框

20. 工作表事件Target参数的使用方法

在工作表的SelectionChange事件中，参数Target代表新选定的区域，在工作表的Change事件中参数Target代表更改的区域。在实际应用中可以使用Target参数将触发工作表事件的区域限制在一定的范围内，有以下几种方法：

20.1 使用单元格的Address 属性

使用单元格的Address属性可以将触发条件限制在某一个单元格中，如下面的代码所示。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Target.Address(0, 0) = "A1" ThenMsgBox "你选择了A1单元格"End If
End Sub

代码解析：
当选择工作表A1单元格时显示一个消息框。
第2行代码使用Address属性返回所选单元格的区域引用，当返回的区域引用是“A1”时触发SelectionChange事件，显示一个消息框。
此方法只适用于单个单元格或者加上OR运算符可以适用于几个单元格，多则不方便。

20.2 使用Column属性和Row属性

使用单元格的Column属性和Row属性可以将触发条件限制在某一区域内，如下面的代码所示。

Private Sub Worksheet_Change(ByVal Target As Range)If Target.Column = 1 And Target.Row < 11 ThenTarget.Offset(, 1) = Val(Target) * 3End If
End Sub

代码解析：
当改变工作表的A1到A10单元格时，如果输入的是数值则将在对应的B列单元格写入乘以3的数值。
第2行代码使用Column属性将触发条件限制在第1列，使用Row属性将触发条件限制在第10行以内，也就是A1到A10的区域范围内。

20.3 使用Intersect方法

使用Intersect方法可以很方便的指定一个或多个区域范围，如下面的代码所示。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Not Application.Intersect(Target, Union(Range("A1:A10"), Range("C1:C10"))) Is Nothing ThenMsgBox "你选择了" & Target.Address(0, 0) & "单元格"End If
End Sub

代码解析：
当选择工作表A1到A10，C1到C10单元格时将所选的单元格地址显示在消息框中。
第2行代码使用Intersect方法判断所选单元格是否与A1到A10，C1到C10单元格重叠，如果重叠说明所选单元格在A1到A10，C1到C10单元格区域内。Intersect方法返回一个Range对象，此对象代表两个或多个范围重叠的矩形区域，语法如下：

expression.Intersect(Arg1, Arg2, ...)

• 参数expression：可选的，返回一个Application对象。
• 参数Arg1, Arg2, …：必需的，重叠的区域。必须指定至少两个 Range对象。

第二章 Worksheet（工作表）对象

21. 引用工作表的方式

VBA中，在不同的工作表之间转换或者对不同工作表中的单元格区域进行操作时，需要指定引用的工作表

21.1 使用工作表的名称

工作表名称是指显示在工作表标签中的文本，工作表名称可以使用WorkSheets 集合和Sheets 集合两种引用方式，如下面的代码所示。

Sub ShActivate()Worksheets("索引号").Activate'Sheets("索引号").Activate
End Sub

第3、4行代码都激活工作簿中名称为“索引号”的工作表，激活后“索引号”工作表将成为活动工作表。
注意：WorkSheets集合包含所有的工作表，而Sheets集合不仅包含工作表集合WorkSheets，还包含图表集合Charts、宏表集合Excel4MacroSheets与MS Excel 5.0对话框集合DialogSheets等。
任何时刻工作簿中只有一个工作表是活动工作表。

21.2 使用工作表的索引号

工作表索引号是指工作表在工作簿中的位置，Excel根据工作表在工作表标签中的位置以1开始从左向右进行编号。下面的代码选中并激活当前工作簿中第1个工作表：

Sub ShIndex()Worksheets(1).Select
End Sub

单个WorkSheet对象的Select方法与Activate方法的主要区别在于Select方法要求工作表可视。
注意：当工作簿包括工作表、宏表、图表等时，使用索引号引用工作表如Sheets(1) 与WorkSheets(1) 引用的可能不是同一个表。
使用Worksheet 对象的Index 属性可以返回工作表的索引号，如下面的代码所示。

Sub ShInde()MsgBox Worksheets("索引号").Index
End Sub

21.3 使用工作表的代码名称

使用Worksheet 对象的CodeName 属性可以返回工作表的代码名称，如下面的代码所示。

Sub ShCodeName()MsgBox Sheets(1).CodeName
End Sub

工作表的代码名称显示在VBE 工程资源管理器窗口中，在属性窗口中能够修改工作表代码名称。在VBA中能够直接使用工作表的代码名称引用工作表，即使工作表的名称被修改，代码仍然能够正常运行。

21.4 使用ActiveSheet属性引用活动工作表

使用ActiveSheet 属性可以返回活动工作表，如下面的代码所示。

Sub ShActive()MsgBox ActiveSheet.Name
End Sub

ActiveSheet 属性应用于AppActivate 对象、Window 对象和Workbook 对象时，如果未给出对象识别符，返回活动工作簿中的活动工作表。

22. 选择工作表的方法

在VBA 中需要激活或者选择某个工作表时使用Select 方法或Activate 方法，如下面的代码所示。

Sub SelectSh()Worksheets("Sheet2").Select
End Sub
Sub ActivateSh()Worksheets("Sheet2").Activate
End Sub

代码解析：
SelectSh 过程使用Select 方法选择“Sheet2” 工作表，而ActivateSh 过程则使用Activate 方法选择“Sheet2” 工作表，从表面看两者的作用是相同的，但是如果“Sheet2” 工作表是隐藏的，Activate 方法可以正常运行，而Select 方法将会出现错误，如下图所示。

如果需要同时选中工作簿中的所有工作表，则只能使用Select 方法而不能使用Activate 方法，如下面的代码所示。

Sub SelectShs()Dim Shs As WorksheetFor Each Shs In WorksheetsShs.Select FalseNext
End Sub
Sub SelectSheets()Worksheets.Select
End Sub
Sub ArraySheets()Worksheets(Array(1, 2, 3)).Select
End Sub

代码解析：
SelectShs 过程遍历工作表并使用带参数的Select 方法选中所有工作表。应用于Worksheet 对象的Select方法 的语法如下：

Select(Replace)

• 参数Replace ：可选的。如果该值为True，则用指定对象替代当前选定对象。如果该值为False，则延伸当前选定对象以包括任何以前选定的对象。
• SelectSheets 过程使用Worksheets集合的Select方法选中集合中所有的对象。
• ArraySheets 过程使用Array 函数返回工作簿中的前三张工作表并使用Worksheets集合的Select方法选中前三张工作表。

23. 遍历工作表的方法

在Excel 应用中经常需要遍历工作簿中所有的工作表，有以下两种方法可以实现。

23.1 使用For…Next 语句

使用For…Next 语句遍历工作簿中所有的工作表，如下面的代码所示。

Sub ShCount1()Dim c As IntegerDim i As IntegerDim s As Stringc = Worksheets.CountFor i = 1 To cs = s & Worksheets(i).Name & Chr(13)NextMsgBox "工作簿中含有以下工作表:" & Chr(13) & s
End Sub

代码解析：
ShCount1 过程使用For…Next 语句遍历工作簿中所有的工作表，并用消息框显示所有的工作表名称。
第5行代码根据Worksheet 对象的Count 属性返回工作簿中工作表的数量赋给变量c。应用于Worksheet 对象的Count 属性返回Worksheets 集合中工作表的数量，语法如下：

expression.Count

第6行代码开始For…Next 语句循环。For…Next 语句以指定次数来重复执行一组语句，语法如下：

For counter = start To end [Step step][statements][Exit For][statements]
Next [counter]

• 参数counter ：必需的，用做循环计数器的数值变量。
• 参数start ： 必需的，循环计数器的初值。
• 参数end ： 必需的，循环计数器的终值。
• 参数step ：可选的，环计数器的步长，缺省值为 1。
• 参数statements ：可选的，放在For和Next之间的一条或多条语句，它们将被执行指定的次数。
  第7行代码在For…Next循环中根据工作表的索引号取得所有工作表的名称赋给字符串变量s。
  运行ShCount 过程结果如下图所示。
  

23.2 使用For Each…Next 语句

使用For Each…Next 语句遍历工作簿中所有的工作表，如下面的代码所示。

Sub ShCount2()Dim Sh As WorksheetDim s As StringFor Each Sh In Worksheetss = s & Sh.Name & Chr(13)NextMsgBox "工作簿中含有以下工作表:" & Chr(13) & s
End Sub

代码解析：
ShCount2 过程使用For Each…Next 语句遍历工作簿中所有的工作表，并用消息框显示所有工作表名称。
第4行代码使用For Each…Next 语句遍历Worksheets 集合中所有元素。For Each…Next 语句针对一个数组或集合中的每个元素，重复执行一组语句，语法如下：

For Each element In Group[statements][Exit For][statements]
Next [element]

• 参数element：必需的，用来遍历集合或数组中所有元素的变量。
• 参数group：必需的，对象集合或数组的名称。
• 参数statements：可选的，针对对象集合或数组中的每一项执行的一条或多条语句。
  第5行代码将返回的工作表的名称赋给字符串变量s。
  运行ShCount2过程结果如下图所示。
  

24. 在工作表中上下翻页

如果需要在工作簿的工作表中进行上下翻页，可以使用下面的代码。

Sub DownSheet()Dim i As Integeri = Worksheets.CountIf ActiveSheet.Index < i ThenWorksheets(ActiveSheet.Index + 1).ActivateElseWorksheets(1).ActivateEnd If
End Sub
Sub UpSheet()Dim i As Integeri = Worksheets.CountIf ActiveSheet.Index > 1 ThenWorksheets(ActiveSheet.Index - 1).ActivateElseWorksheets(i).ActivateEnd If
End Sub

代码解析：

• DownSheet 过程向下翻页，第3、12行代码使用Worksheets 对象的Count 属性取得工作表的数目，第4行到第7行代码根据Index 属性判断活动工作表是否是工作簿中的最后一张工作表。如果活动工作表不是最后一张工作表则激活活动工作表的下一张工作表，否则激活第一张工作表。
• UpSheet 过程向上翻页，第13行到第16行代码根据Index属性判断活动工作表是否是工作簿中的第一张工作表。如果活动工作表不是第一张工作表则激活活动工作表的上一张工作表，否则激活最后一张工作表。

25. 工作表的添加与删除

在工作簿中添加工作表使用Add 方法，如下面的代码所示。

Sub Addsh()Dim Sh As WorksheetWith WorksheetsSet Sh = .Add(after:=Worksheets(.Count))Sh.Name = "数据"   '将添加的工作表重命名为“数据”。End With
End Sub

代码解析：
Addsh 过程使用Add 方法在工作簿中新建“数据”工作表。
第2行代码声明变量Sh 为工作表对象。
第4行行代码使用Add 方法在工作簿的最后新建“数据”工作表。
Add 方法应用于Sheets 和Worksheets 对象时新建工作表、图表或宏表，语法如下：

expression.Add(Before, After, Count, Type)

• 参数Before 是可选的，指定工作表对象，新建的工作表将置于此工作表之前。
• 参数After 是可选的，指定工作表对象，新建的工作表将置于此工作表之后。
• 如果Before和 After两者均省略，则新建的工作表将插入到活动工作表之前。
• 参数Count 可选，要新建的工作表的数目。默认值为 1。
• 参数Type 可选，指定新建的工作表类型。

如果需要在工作簿中批量添加工作表，可以使用下面的代码。

Sub Addsh_2()Dim i As IntegerDim sh As WorksheetFor i = 1 To 10Set sh = Sheets.Add(after:=Sheets(Sheets.Count))sh.Name = iNext
End Sub

代码解析：
Addsh_2 过程使用For…Next 语句和Add 方法在工作簿中添加10张工作表并将添加的工作表依次重命名。
在使用以上代码往工作簿中添加工作表时，如果工作簿中已存在相同名称的工作表，运行时会发生错误，代码中断，如下图所示。

为了避免此错误的发生，可以在添加前先删除所有的工作表，如下面的代码所示。

Sub Delsh()Dim sh As WorksheetFor Each sh In ThisWorkbook.SheetsIf sh.Name <> "工作表的添加与删除" ThenApplication.DisplayAlerts = Falsesh.DeleteApplication.DisplayAlerts = TrueEnd IfNext
End Sub

代码解析：
Delsh 过程使用Delete 方法删除工作簿中除了“工作表的添加与删除”工作表以外所有的工作表。
第3行代码使用For Each…Next语句遍历代码所在工作簿中所有的工作表。
第4行到第7行代码判断工作表名称是否为“工作表的添加与删除”,如果不是则使用Delete方法删除。其中第5行代码将Application对象的DisplayAlerts属性设置为False，使删除时不显示如图 25 2所示系统警告对话框。

图 25 2 系统警告对话框
第6行代码使用Delete方法删除工作表，应用于工作表对象的Delete方法删除指定的对象，语法如下：

expression.Delete

参数expression是必需的，该表达式返回“应用于”列表中的对象之一。
在运行添加工作表代码前先删除工作簿中的工作表虽然可以避免同名错误,但也可能误删除有用的工作表,因此更为严谨的方法是在添加前先判断工作簿中是否存在相同名称的工作表,然后再进行下一步的操作。
对于单张工作表可以使用下面的代码。

Sub Addsh_3()Dim Sh As WorksheetFor Each Sh In WorksheetsIf Sh.Name = "数据" ThenMsgBox "工作簿中已有""数据""工作表,不能重复添加!"Exit SubEnd IfNextWith WorksheetsSet Sh = .Add(after:=Worksheets(.Count))Sh.Name = "数据"End With
End Sub

代码解析：
Addsh_3过程在使用Add方法在工作簿中新建“数据”工作表时首先判断工作簿中是否存在“数据”工作表，如果已存在“数据”工作表则不运行添加工作表的代码而只显示一个消息框进行提示，如下图所示。

还可以使用错误处理语句来绕过错误，如下面的代码所示。

Sub Addsh_4()Dim sh As WorksheetOn Error GoTo lineWith WorksheetsSet sh = .Add(after:=Worksheets(.Count))sh.Name = "数据"End WithExit Sub
line:MsgBox "工作簿中已有""数据""工作表,不能重复添加!"Application.DisplayAlerts = FalseWorksheets(Worksheets.Count).DeleteApplication.DisplayAlerts = True
End Sub

代码解析：
Addsh_4 过程是先使用Add 方法在工作簿中新建“数据”工作表，如果工作簿中已存在同名的工作表则使用GoTo 语句转移到指定的line行处进行提示并删除已添加还没有重命名的工作表，也就是工作簿中最后一张工作表。
如果是批量添加工作表，使用上述方法时，添加工作表和已有工作表重名时，后面即使没有重名的工作表也不能添加，所以应先使用错误处理语句忽略错误，待全部添加好以后再删除多余的工作表，如下面的代码所示。

Sub Addsh_5()Dim i As Integer, arrDim sh As WorksheetOn Error Resume Nextarr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)For i = 0 To UBound(arr)With WorksheetsSet sh = .Add(after:=Sheets(.Count))sh.Name = arr(i)End WithNextApplication.DisplayAlerts = FalseFor Each sh In WorksheetsIf sh.Name Like "Sheet*" Then sh.DeleteNextApplication.DisplayAlerts = True
End Sub

代码解析：
Addsh_5过程使用Add方法在工作簿中添加10张工作表并重新命名为1到10，如果工作簿中已有相同名称的工作表则不添加。
第4行代码错误处理语句，当发生重名错误时忽略错误，继续添加工作表。
第5行到第11行代码在工作簿中添加10张工作表并重新命名为1到10，如果工作簿中已有相同名称的工作表则忽略错误重命名时发生的错误，此时工作簿中添加的工作表会以系统赋与的名称命名，如“Sheet1”。
第12行到第15行代码使用For Each…Next语句遍历工作簿中所有的工作表，将工作簿中凡是以“Sheet”开头的工作表删除。

26. 禁止删除指定工作表

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

Public Ctl As CommandBarControl
Sub DelSht()Set Ctl = Application.CommandBars.FindControl(ID:=847)Ctl.OnAction = "MyDelSht"
End Sub
Sub ResSht()Set Ctl = Application.CommandBars.FindControl(ID:=847)Ctl.OnAction = ""
End Sub
Sub MyDelSht()If VBA.UCase$(ActiveSheet.CodeName) = "SHEET2" ThenMsgBox "禁止删除" & ActiveSheet.Name & "工作表!"ElseActiveSheet.DeleteEnd If
End Sub

代码解析：

• DelSht 过程将工作表标签右键菜单中的“删除工作表”菜单的OnAction 属性设置为“MyDelSht”。
  第3行代码使用Set 语句将工作表标签右键菜单中的“删除工作表”菜单赋给变量Ctl，并将其OnActio 属性设置为MyDelSht 过程，该菜单被单击时将运行“MyDelSht”过程而不是系统默认的设置。OnAction 属性返回或设置一个VBA的过程名，该过程在用户单击或更改某命令栏控件的值时运行。
• ResSht 过程将工作表标签右键菜单中的“删除工作表”菜单的OnAction属性恢复为默认设置。
• MyDelSht过程判断所要删除的工作表的代码名称是否是“SHEET2”，如果是则禁止删除该表而只显示一个提示消息框。
  为了不影响其他工作簿的使用，在VBE中双击ThisWorkbook 写入下面的代码。

Private Sub Workbook_Activate()Call DelSht
End Sub
Private Sub Workbook_Deactivate()Call ResSht
End Sub

代码解析：
工作簿的Activate 事件和Deactivate 事件代码，在工作簿激活时运行DelSht 过程，在关闭或打开其他工作簿时运行ResSht 过程，这样只禁止删除本工作簿中“SHEET2”工作表，并不影响其他工作簿。
当删除本工作簿中的“SHEET2”工作表时，并不会显示如图 26 1所示的消息框，而只会显示如图 26 2所示的禁止删除工作表的消息框。

图 26 1 删除工作表提示

图 26 2 禁止删除工作表

27. 自动建立工作表目录

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

Private Sub Worksheet_Activate()Dim sh As WorksheetDim a As IntegerDim R As IntegerR = Sheet1.[A65536].End(xlUp).Rowa = 2If Sheet1.Cells(2, 1) <> "" ThenSheet1.Range("A2:A" & R).ClearContentsEnd IfFor Each sh In WorksheetsIf sh.CodeName <> "Sheet1" ThenSheet1.Cells(a, 1).Value = sh.Namea = a + 1End IfNext
End Sub

代码解析：
工作表的Activate 事件，在“目录”工作表激活时自动建立工作簿中除“目录”工作表外所有工作表的目录。
第2、3、4行代码声明变量类型。
第5行代码取得A列最后非空单元格的行号。
第6行代码设置变量a的初始值为2，从A2单元格开始建立工作表目录。
第7行到第9行代码判断是否存在工作表目录，如果存在先清空原来的目录，以便更新目录。
第10行到第15代码遍历工作簿的所有工作表，将除“目录”工作表外所有工作表的名称写入到A列单元格中。
为了建立到各工作表的链接，使用工作表的SelectionChange 事件，如下面的代码所示。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)Dim R As IntegerR = Sheet1.[A65500].End(xlUp).RowOn Error Resume NextIf Target.Count = 1 ThenIf Target.Column = 1 ThenIf Target.Row > 1 And Target.Row <= R ThenSheets(Target.Value).SelectEnd IfEnd IfEnd If
End Sub

代码解析：
工作表的SelectionChange事件，当选择A列工作表目录中工作表名称时自动选择该单元格所对应的工作表。
第5、6、7行代码限制该事件触发的条件。
第8行代码选择单元格所对应的工作表。
“目录”工作表激活后自动在A列建立工作簿中除“目录”工作表以外所有表的目录，如图 27 1所示。

图 27 1 自动建立工作表目录

28. 工作表的深度隐藏

在使用VBA开发的工作簿文件完成交与用户使用后，我们往往希望用户在打开工作簿时启用宏，此时除了使用“禁用宏则关闭工作簿”的功能外，还可以隐藏所有有数据的工作表，如果用户在打开工作簿时禁用宏则只显示一张空白的工作表，达到强制启用宏的效果，代码如下：

Dim sh As Worksheet
Private Sub Workbook_BeforeClose(Cancel As Boolean)Sheet1.Visible = TrueFor Each sh In ThisWorkbook.SheetsIf sh.Name <> "空白" Thensh.Visible = xlSheetVeryHiddenEnd IfNextActiveWorkbook.Save
End Sub
Private Sub Workbook_Open()For Each sh In ThisWorkbook.SheetsIf sh.Name <> "空白" Thensh.Visible = xlSheetVisibleEnd IfNextSheet1.Visible = xlSheetVeryHidden
End Sub

代码解析：
第2行到第10行代码是工作簿的BeforeClose事件过程，在工作簿关闭前隐藏除“空白”表以外的所有的工作表。
第3行代码将“空白”表的Visible属性设置为True，使其可见。
应用于Charts和Worksheets对象的Visible属性决定对象是否可见，语法如下：

expression.Visible

参数expression是必需的，该表达式返回上面的对象之一。
Visible属性可以设置为表格 28 1所示的XlSheetVisibility常量之一。
常量 值 描述
xlSheetHidden 0 隐藏对象，可以通过“格式”→“工作表”→“取消隐藏”菜单使对象重新可见，等同于设置为False。
xlSheetVisible -1 使对象重新可见，等同于设置为True。
xlSheetVeryHidden 2 隐藏对象，使该对象重新可见的唯一方法是将此属性设置为True或xlSheetVisible。
表格 28 1 XlSheetVisibility常量
第4行到第8行代码使用For Each…Next语句遍历工作簿中所有的工作表，将除“空白”表以外的所有工作表的Visible属性设置为xlSheetVeryHidden，使之隐藏。
Visible属性设置为xlSheetVeryHidden后工作表不能通过“格式”→“工作表”→“取消隐藏”菜单来显示隐藏的工作表。
第9行代码使用Save方法保存代码所在工作簿的更改，在关闭工作簿时不显示如图 28 1所示的消息框。

图 28 1 工作簿保存提示
第10行到第18行代码是工作簿的Open事件过程，在打开工作簿时将除“空白”表以外的所有工作表的Visible属性设置为xlSheetVisible，取消隐藏。如果打开工作簿时禁用宏，则工作簿中除了“空白”表以外，其他的工作表还处于深度隐藏的状态，如图 28 2所示，这样就达到强制用户启用宏的效果，当然这还需要VBA工程保护的配合。

图 28 2 工作表深度隐藏

29. 防止更改工作表的名称

工作表的名称显示在工作表标签上，除了在相应的功能菜单中可以对其进行重命名操作外，在工作表标签上双击鼠标也能修改工作表名称。一旦修改了工作表名称，可能就会产生一连串的问题，例如在其他工作簿中对该工作表的引用将会失效，通过工作表名称引用工作表的代码也将出错。
Excel没有提供修改工作表名称的相关事件，要禁止用户修改工作表名称，需采取其他一些技巧。比如在工作表BeforeClose事件中检验工作表名称，如果工作表名称不是指定的字符串，则将其修改为指定字符串，即保持工作表名称不变，代码如下。

Private Sub Workbook_BeforeClose(Cancel As Boolean)If Sheet1.Name <> "Excel Home" Then Sheet1.Name = "Excel Home"ThisWorkbook.Save
End Sub

代码解析：
工作簿的BeforeClose事件过程，在关闭当前工作簿时判断Sheet1工作表名称，如果不是指定的字符串“Excel Home”，则将其恢复为“Excel Home”后保存工作簿，从而避免更改Sheet1工作表名称。

30. 工作表中一次插入多行

在工作表的中插入多行空行，需要使用Insert方法，如下面的代码所示。

Sub InSertRows_1()Dim i As IntegerFor i = 1 To 3Sheet1.Rows(3).InsertNext
End Sub

代码解析：
InSertRows_1过程使用Insert方法在如图所示的数据区域的第2行和第3行之间插入三行空行。

Insert 方法应用于Range 对象时在工作表或宏表中插入一个单元格或单元格区域，其他单元格作相应移位以腾出空间，语法如下：

expression.Insert(Shift, CopyOrigin)

• 参数expression：必需的，该表达式返回一个Range对象。
• 参数Shift：可选的，指定单元格的移动方向。可为以下 XlInsertShiftDirection 常量之一：xlShiftToRight 或 xlShiftDown。如果省略本参数，Microsoft Excel 将依据该区域的形状决定移动方向。
• 参数CopyOrigin：可选的，复制的起点。
  还可以使用引用多行的方法，如下面的代码所示。

Sub InSertRows_2()Sheet2.Range("A3").EntireRow.Resize(3).Insert
End Sub

代码解析：
InSertRows_2 过程通过引用多行区域的方法实现一次插入多行。
第2行代码中的Range(“A3”).EntireRow属性返回Range(“A3”)单元格所在的一整行，然后使用Resize属性调整行数后插入三行空行。
也可以直接指定相应行再调整行数后插入空行，如下面的示例代码：

 Sub InSertRows_3()Sheet3.Rows(3).Resize(3).InsertEnd Sub

运行以上过程，工作表中如图所示。

31. 删除工作表中的空行

如果需要删除如图所示的工作表中所有的空行，可以使用下面的代码。

Sub DelBlankRow()Dim rRow As LongDim LRow As LongDim i As Long'获得工作表中已使用区域的首行行号，其中使用UsedRange属性返回工作表中已使用的区域。rRow = Sheet1.UsedRange.Row'第6行代码获得工作表中已使用区域的最后一行行号。LRow = rRow + Sheet1.UsedRange.Rows.Count - 1'从最大行数至最小行数循环判断指定行是否为空行，若为空行则删除该行。使用工作表CountA函数判断当前行已使用单元格的数量，如果为零说明此行是空行则使用Delete删除。For i = LRow To rRow Step -1If Application.WorksheetFunction.CountA(Rows(i)) = 0 ThenRows(i).DeleteEnd IfNext
End Sub

代码解析：
DelBlankRow 过程删除工作表中已使用的区域的所有空行。

注意：此处一定要从最大行数至最小行数开始循环判断，因为如果工作表中存在两行及两行以上的相邻空行，从最小行数开始循环删除的话，当第一行空行被删除后，被删除行下面的一行会往上移位，而此时For…Next循环的计数器已经加1，所以会出现漏删除的现象。

应用于Range对象的Delete方法删除对象，语法如下：

expression.Delete(Shift)

• 参数expression：必需的，返回一个Range对象。
• 参数Shift：可选的，指定删除单元格时替补单元格的移位方式。可为以下 XlDeleteShiftDirection 常量之一：xlShiftToLeft或xlShiftUp。如果省略该参数，则Microsoft Excel将根据区域的图形决定移位方式。
  运行DelBlankRow过程工作表区域如图 所示。
  

32. 删除工作表的重复行

在实际应用中，可能需要删除如图所示的工作表中A列的重复内容而只保留一行，那么可以借助工作表CountIf函数来完成，如下面的代码所示。

Sub DeleteRow()Dim R As IntegerDim i As IntegerWith Sheet1'取得工作表中A列的最后一个非空单元格的行号R = .[a65536].End(xlUp).Row'从最大行数至最小行数循环判断A列单元格内容是否重复并删除重复单元格所在的整行。此处For...Next循环也要从最大行数至最小行数开始循环判断，否则可能会删除不净；使用工作表CountIf函数判断单元格内容是否重复，如果重复则删除该单元格所在的行。For i = R To 1 Step -1If WorksheetFunction.CountIf(.Columns(1), .Cells(i, 1)) > 1 Then.Rows(i).DeleteEnd IfNextEnd With
End Sub

代码解析：
DeleteRow 过程删除工作表A列重复单元格所在的整行内容，只保留一行。

运行DeleteRow过程工作表区域如图所示。

33. 定位删除特定内容所在的行

如果需要删除如图所示的工作表区域中特定内容所在的行，可以使用定位的方法快速删除，无需使用For…Next循环对单元格逐个进行判断。

示例代码如下：

Sub SpecialDelete()Dim R As IntegerWith Sheet1R = .Range("a65536").End(xlUp).Row'使用Replace方法将工作表A列中显示为“Excel”的单元格内容替换成空白。.Range("a2:a" & R).Replace "Excel", "", 2'使用SpecialCells方法定位到工作表A列中所有的空单元格，使用Range对象的EntireRow属性返回其所在的整个行一次性删除。.Columns(1).SpecialCells(4).EntireRow.DeleteEnd With
End Sub

代码解析：
SpecialDelete过程删除工作表A列单元格中显示为“Excel”的行。

运行SpecialDelete过程工作表区域如图所示。

34. 判断是否选中整行

通过当前选择的单元格区域的单元格数目与行数或列数相比较，判断用户是否选中了整行或整列，如下面的代码所示。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Target.Rows.Count返回目标区域的行数，确定用户当前选择区域的总行数是否为1。If Target.Rows.Count = 1 Then' Target.Columns.Count返回目标区域的列数，确定用户当前选择区域总列数是否为256。If Target.Columns.Count = 256 Then'当用户选中一整行时显示一个消息框，提示用户当前选择的行号MsgBox "您选中了整行,当前行号" & Target.RowEnd IfEnd If
End Sub

代码解析：
工作表的SelectionChange 事件，判断用户是否选中了工作表中一整行单元格区域。

如果需要判断是否选中了整列，只需将上面代码中的总行数修改为65536，总列数修改为1。

35. 限制工作表的滚动区域

如果希望限制工作表中滚动的区域，可以通过设置WorkSheet 对象的ScrollArea 属性来实现。ScrollArea 属性使用以A1 样式的区域引用形式（字符串类型）返回或设置工作表允许滚动的区域。当设置了工作表滚动区域之后，用户不能选定滚动区域之外的单元格，但仍然可以选定区域之外的其他对象（例如图形、按钮等），同时工作表的一些相应功能可能被禁止（例如工作表全选、选中整行或整列等）。
在VBE 中的工程管理窗口选择相应工作表对象，然后在其属性窗口中设置ScrollArea属性，即可限制工作表中滚动的区域，如图 35 1所示。

图 35 1 设置ScrollArea属性
但是Excel不会记忆该项设置，当再次打开该工作簿时，ScrollArea属性将被重置，用户必须重新设置ScrollArea属性才能限制工作表中的滚动区域，解决方法是使用代码在工作簿打开时对ScrollArea属性进行设置，如下面的代码所示。

Private Sub Workbook_Open()Sheet1.ScrollArea = "B4:H12"
End Sub

代码解析：
工作簿的Open事件，在打开该工作簿时设置Sheet1工作表的滚动区域为“B4:H12”单元格区域。
如果需要取消滚动区域的限制，可以将ScrollArea属性值设置为空，如下面的代码所示。

Sheet1.ScrollArea = ""

36. 复制自动筛选后的数据区域

用户在对如图所示的数据列表进行自动筛选后，往往希望将自动筛选的结果复制到其它地方。

这时可以通过获取该列表区域中可见单元格的方法得到筛选结果的单元格区域，并复制到工作表Sheet2 中，如下面的代码所示。

Sub CopyFilter()
'清除Sheet2表中数据。Sheet2.Cells.ClearWith Sheet1'判断Sheet1表是否处于自动筛选状态。'FilterMode属性返回工作表是否处于筛选模式，如果指定工作表中包含已筛选序列且该序列中含有隐藏行，则该值为True。If .FilterMode Then'通过AutoFilter对象的Range属性返回工作表的自动筛选列表区域，再使用SpecialCells方法获取该列表区域中可见单元格，得到筛选结果的单元格区域，然后使用Copy方法将结果区域复制到工作表Sheet2中，应用于Range对象的Copy方法将单元格区域复制到指定的区域或剪贴板中.AutoFilter.Range.SpecialCells(12).Copy Sheet2.Cells(1, 1)End IfEnd With
End Sub

代码解析：
CopyFilter过程将Sheet1表中的筛选结果复制到工作表Sheet2中。

语法如下：

expression.Copy(Destination)

• 参数expression：必需的，该表达式返回一个Range对象。
• 参数Destination：可选的，指定区域要复制到的目标区域。如果省略该参数，则将该区域复制到剪贴板中。
  运行CopyFilter过程工作表Sheet2 如图所示。
  

37. 使用高级筛选获得不重复记录

在如图所示的数据列表中，如果要将其中不重复的记录复制到另一工作表中，则可以通过高级筛选功能实现。

示例代码如下：

Sub Filter()Sheet1.Range("A1").CurrentRegion.AdvancedFilter _Action:=xlFilterCopy, Unique:=True, _CopyToRange:=Sheet2.Range("A1")
End Sub	

代码解析：
Filter过程使用AdvancedFilter 方法对单元格A1的当前区域筛选不重复的记录，并将筛选结果复制到工作表Sheet2中。应用于Range集合的AdvancedFilter方法语法如下：

AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique)

• 参数Action：必需的，可以为表格所列的XlFilterAction常量之一。

XlFilterAction 常量	值	描述
xlFilterCopy	2	将筛选结果复制到其他位置
xlFilterInPlace	1	在原有区域显示筛选结果

• 参数CriteriaRange：指定高级筛选操作的条件区域，缺省时表示没有条件限制。
• 参数CopyToRange：表示指定被复制行的目标区域，仅当Action为xlFilterCopy时有效，否则忽略本参数。
• 参数Unique：指示是否选择不重复的记录，如果其值为True，则重复出现的记录仅保留一条；如果其值为 False（默认值），则筛选出所有符合条件的记录。

38. 工作表的保护与解除保护

在在实际应用中，Excel编制的报表、表格、程序等，往往在单元格中设置了公式、函数、自定义格式等，为了防止在使用过程中修改或无意中修改这些设置，一般使用Excel的工作表保护功能来保护这些设置。
但是程序中可能会使用代码对受保护的工作表进行操作，此时如果没有解除工作表保护，运行出现错误，如图 38 1所示。

图 38 1 运行错误提示
解决方法是在运行操作工作表的代码前先使用代码解除工作表保护，待操作完毕后再保护工作表，如下面的代码所示。

Sub ShProtect()With Sheet1.Unprotect Password:="12345"'在单元格录入数据后使用Protect方法重新保护工作表。.Cells(1, 1) = 100.Protect Password:="12345"End With
End Sub

代码解析：
ShProtect过程在受保护的工作表中对单元格进行操作，其中第3行代码使用Unprotect方法解除工作表的保护。应用于Worksheet 对象的Unprotect方法解除工作表的保护，如果工作表不是受保护的，则此方法不起作用，所以在解除之前无需判断工作表是否受保护，其语法如下：

expression.Unprotect(Password)

• 参数expression：必需的，该表达式返回一个Worksheet 对象。
  *参数Password：可选的，指定用于解除工作表的保护的密码，此密码是区分大小写的。
  应用于Worksheet对象的Protect方法保护工作表使其不至被修改，语法如下：

expression.Protect(Password, DrawingObjects, Contents, Scenarios, UserInterfaceOnly, AllowFormattingCells, AllowFormattingColumns, AllowFormattingRows, AllowInsertingColumns, AllowInsertingRows, AllowInsertingHyperlinks, AllowDeletingColumns, AllowDeletingRows, AllowSorting, AllowFiltering, AllowUsingPivotTables) 

• 参数expression：必需的，该表达式返回一个Worksheet对象。
• 参数Password：可选的，为一个字符串，该字符串为工作表指定区分大小写的密码。
• 其他参数都是可选参数，其功能等同于如图 38 2所示的工作表保护对话框中的各项选项，具体请参阅VBA帮助。

图 38 2 工作表保护选项
如果一个Excel文件使用时间过长，忘记了工作表保护时设置的密码，那么也可以使用VBA解除工作表的保护，代码如下：

Sub RemoveShProtect()Dim i1 As Integer, i2 As Integer, i3 As IntegerDim i4 As Integer, i5 As Integer, i6 As IntegerDim i7 As Integer, i8 As Integer, i9 As IntegerDim i10 As Integer, i11 As Integer, i12 As IntegerOn Error Resume NextIf ActiveSheet.ProtectContents = False ThenMsgBox "该工作表没有保护密码！"Exit SubEnd IfFor i1 = 65 To 66: For i2 = 65 To 66: For i3 = 65 To 66For i4 = 65 To 66: For i5 = 65 To 66: For i6 = 65 To 66For i7 = 65 To 66: For i8 = 65 To 66: For i9 = 65 To 66For i10 = 65 To 66: For i11 = 65 To 66: For i12 = 32 To 126ActiveSheet.Unprotect Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) _& Chr(i6) & Chr(i7) & Chr(i8) & Chr(i9) & Chr(i10) & Chr(i11) & Chr(i12)If ActiveSheet.ProtectContents = False ThenMsgBox "已经解除了工作表保护！"Exit SubEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: Next
End Sub

代码解析：
RemoveShProtect过程解除工作表的保护。
其中第7行到第10行代码判断工作表是否受保护，ProtectContents属性返回工作表的保护状态，如果工作表的内容处于保护状态，则该值为True。
第11行到第22行代码使用For…Next 语句和Chr函数来返回指定字符码所代表的字符串组合不断地尝试解除工作表保护，一旦工作表的ProtectContents属性返回False说明已经解除工作表保护。

39. 奇偶页打印

在Excel中却没有提供打印奇数页和偶数页的功能，用户可以使用VBA在Excel中实现该功能，如下面的代码所示。

Sub PrintOddPage()Dim TotalPg As IntegerTotalPg = ExecuteExcel4Macro("GET.DOCUMENT(50)")For i = 1 To TotalPg Step 2ActiveSheet.PrintOut From:=i, To:=iNext
End Sub

代码解析：
第3行代码使用Excel 4.0宏表函数获取总页数，通过该函数获取总页数而无需判断分页符。
第4行到第6行代码逐页打印所有奇数页，其中第5行代码中的参数From和To指定打印的开始页数和结束页数。
将第4行代码中的数值改为2，则实现偶数页的打印。

第三章 Wordbook（工作簿）对象

40. 工作簿的引用方法

VBA中，在不同的工作簿之间转换需要指定引用的工作簿，通常有下面几种方法。

40.1 使用工作簿的名称

工作簿名称是指Excel文件的文件名，可以使用Workbooks集合引用方式来引用工作簿，如下面的代码所示。

Sub WbPath ()MsgBox "名称为：" & Workbooks("工作簿的引用方法.xls").Path
End Sub

代码解析：
WbPath过程显示工作簿“工作簿的引用方法”的路径。应用于Workbook对象的Path属性将完整路径返回给应用程序，语法如下：

expression.Path

参数expression：必需的，一个有效的对象。
运行WbPath过程结果如图 40 1所示。

图 40 1 返回工作簿完整路径

40.2 使用工作簿的索引号

工作簿索引号是指工作簿打开的顺序，Excel根据工作簿打开的顺序以1开始进行编号。下面的代码显示应用程序打开的第一个工作簿的名称。

Sub WbName()MsgBox "第一个打开的工作簿名字为：" & Workbooks(1).Name
End Sub

代码解析：
WbName过程显示应用程序打开的第一个工作簿的名称。应用于Workbook对象的Name属性返回对象的名称，语法如下：

expression.Name

参数expression：必需的，一个有效的对象。
运行WbName过程结果如图 40 2所示。

图 40 2 返回工作簿名称
如果需要返回包含完整路径的工作簿名称则使用Workbook对象的FullName属性，如下面的代码所示。

Sub WbFullName()MsgBox "包括完整路径的工作簿名称为：" & Workbooks(1).FullName
End Sub

WbFullName过程显示应用程序打开的第一个工作簿的完整路径和名称。FullName属性返回对象的名称，包括其磁盘路径的字符串，此属性等价于在Path属性后加上当前文件系统的分隔符，然后加上Name属性。
运行WbFullName过程结果如图 40 3所示。

图 40 3 返回包含完整路径的工作簿名称

40.3 使用ThisWorkbook

使用ThisWorkbook代表当前宏代码运行的工作簿，如下面的代码所示。

Sub WbClose()ThisWorkbook.Close SaveChanges:=False
End Sub

代码解析：
WbThis过程使用Close方法关闭当前宏代码运行的工作簿，不保存对工作簿的任何更改。关于应用于Workbook对象的Close方法请参阅技巧45-1。
注意 本属性仅可在 Microsoft Excel内使用。不能使用此属性访问任何其他应用程序的工作簿。

40.4 使用ActiveWorkbook

使用ActiveWorkbook代表活动窗口（最上面的窗口）的工作簿，如下面的代码所示。

Sub WbActive()MsgBox "当前活动工作簿名字为：" & ActiveWorkbook.Name
End Sub

代码解析：
WbActive过程显示活动工作簿的名称，ActiveWorkbook属性返回一个Workbook对象，该对象代表活动窗口（最上面的窗口）的工作簿。如果没有打开任何窗口或者活动窗口为信息窗口或剪贴板窗口，则返回 Nothing。
运行WbActive过程结果如图 40 4所示。

图 40 4 返回活动工作簿名称

41. 新建工作簿文件

在VBA中使用Add方法新建工作簿，如下面的代码所示。

Sub AddNowbook()Dim Nowbook As WorkbookDim ShName As VariantDim Arr As VariantDim i As IntegerDim myNewWorkbook As IntegermyNewWorkbook = Application.SheetsInNewWorkbookShName = Array("余额", "单价", "数量", "金额")Arr = Array("01月", "02月", "03月", "04月", "05月", "06月", "07月", "08月", "09月", "10月", "11月", "12月")Application.SheetsInNewWorkbook = 4Set Nowbook = Workbooks.AddWith NowbookFor i = 1 To 4With .Sheets(i).Name = ShName(i - 1).Range("B1").Resize(1, UBound(Arr) + 1) = Arr.Range("A2") = "品名"End WithNext.SaveAs Filename:=ThisWorkbook.Path & "\" & "存货明细.xls".Close Savechanges:=TrueEnd WithSet Nowbook = NothingApplication.SheetsInNewWorkbook = myNewWorkbook
End Sub

代码解析：
AddNowbook过程使用Add方法建立新的工作簿并对新建工作簿进行操作。
第2行到第6行代码声明变量类型。
第7行代码保存Excel自动插入到新工作簿中的工作表数目。
第8、9行代码将数组元素赋值给变量。
第10行代码将Application对象的SheetsInNewWorkbook属性设置为4，在新建工作簿时插入4张工作表。
第11行代码使用Add方法建立新的工作簿，应用于Workbooks对象的Add方法新建工作簿，新建的工作簿将成为活动工作簿。
第12行到第22行代码操作新建工作簿。其中第15行到第17行代码将新建工作簿的工作表进行重命名并给单元格赋值。第20行代码使用SaveAs方法将新建工作簿重命名为“存货明细.xls”保存在同一目录中。关于SaveAs方法请参阅技巧47-2。第21行代码使用Close方法关闭工作簿。关于Close方法请参阅技巧45-1。
第24行代码恢复工作簿的默认设置。
运行AddNowbook过程将在工作簿同一目录中新建“存货明细.xls”工作簿，新建工作簿格式如图 41 1所示。

图 41 1 新建“存货明细.xls”工作簿格式
注意 本例中没有考虑工作簿同名因素，如果目录中已有“存货明细.xls”工作簿，运行时会显示如图 41 2所示的对话框，选择“是”即可，否则将会出错。

图 41 2 同名提示

42. 打开指定的工作簿

VBA中使用Open方法打开一个工作簿，如下面的代码所示。

Sub Openfile()Dim x As IntegerFor x = 1 To Workbooks.CountIf Workbooks(x).Name = "123.xls" ThenMsgBox """123""工作簿已经打开!"Exit SubEnd IfNextWorkbooks.Open ThisWorkbook.Path & "\123.xls"
End Sub

代码解析：
Openfile过程打开同一目录中的“123”工作簿。
第3行代码利用Workbook对象的Count属性取得打开工作簿的数目，使用For…Next 语句遍历所有打开的工作簿。遍历工作簿除了使用For…Next 语句外还可以使用For…Each…Next语句来遍历Workbook对象集合中的所有元素。
第4行到第8行代码遍历所有打开的工作簿，如果Workbook对象集合中存在“123”工作簿，说明“123”工作簿已打开，则显示一条如图 42 1所示的提示信息。

图 42 1 工作簿已打开提示
第9行代码如果“123”工作簿没有被打开则使用Open方法打开“123”工作簿。
Open方法应用于Workbooks 对象时打开一个工作簿，语法如下：

expression.Open(FileName, UpdateLinks, ReadOnly, Format, Password, WriteResPassword, IgnoreReadOnlyRecommended, Origin, Delimiter, Editable, Notify, Converter, AddToMru, Local, CorruptLoad)

• 参数expression：必需的，返回一个Workbooks对象
• 参数FileName：必需的，要打开的工作簿的文件名。
• 参数UpdateLinks：可选的，指定文件中链接的更新方式。如果省略本参数，则提示用户选择链接的更新方式。否则，该参数的取值应为表格 42 1中的某个值。

值	描述
0	不更新任何引用
1	更新外部引用，但不更新远程引用
2	更新远程引用，但不更新外部引用
3	同时更新远程引用和外部引用

• 参数ReadOnly：可选的，如果该值为True，则以只读模式打开工作簿。
• 参数Format：可选的，如果Microsoft Excel正在打开一个文本文件，则该参数用于指定分隔字符，如表格 42 2所示。如果省略本参数，则使用当前的分隔符。

值	分隔符
1	制表符
2	逗号
3	空格
4	分号
5	没有分隔符
6	自定义字符(请参阅 Delimiter 参数)

• 参数Password：可选的，该字符串指定打开一个受保护工作簿的密码。如果省略该参数并且指定工作簿已设置密码，则提示用户输入密码。
• 参数WriteResPassword：可选的，该字符串为一个写保护工作簿的写入权密码。如果省略该参数并且指定工作簿已设置密码，则提示用户输入密码。
• 参数IgnoreReadOnlyRecommended：可选的，如果该值为True，则设置Microsoft Excel不显示建议只读消息（如果该工作簿以“建议只读”选项保存）。
• 参数Origin：可选的，如果文件为文本文件，则该参数用于指示该文件来源于何种操作系统。
• 参数Delimiter：可选的，如果该文件为文本文件并且Format参数为 6，则此参数用于指定用作分隔符的字符。
• 参数Editable：可选的，如果该文件为Microsoft Excel 4.0加载宏，则该参数的值为True时可打开该加载宏以便在窗口中看到。如果该参数的值为False或者省略该参数，则该加载宏以隐藏方式打开，并且无法设为可见。
• 参数Notify：可选的，当该文件不能以可读写模式打开时，如果该参数的值为True，则可将该文件添加到文件通知列表。
• 参数Converter：可选的，打开文件时试用的第一个文件转换器的索引号。
• 参数AddToMru：可选的，如果该值为True，则将该工作簿添加到最近使用的文件列表中。默认值为False。
• 参数Local：可选的，如果该值为True，则以Microsoft Excel（包括控制面版设置）的语言保存文件。如果该值为False（默认值），则以 Visual Basic for Applications (VBA)的语言保存文件，其中Visual Basic for Applications (VBA)为典型安装的美国英语版本，除非VBA项目的Workbooks.Open来自旧的国际化的XL5/95 VBA项目。
• 参数CorruptLoad：可选的，可为以下常量之一：xlNormalLoad、xlRepairFile 和 xlExtractData。如果未指定任何值，则默认值通常为普通状态。

43. 判断指定工作簿是否打开

43.1 遍历Workbooks集合方法

通过遍历当前应用程序所有已打开的工作簿文件(Workbooks集合)，判断指定名称的工作簿是否打开，如下面的代码所示。

Sub WorkbookIsOpen_1()Dim Wb As WorkbookDim myWb As StringmyWb = "Excel Home.xls"For Each Wb In WorkbooksIf Wb.Name = myWb ThenMsgBox "工作簿" & myWb & "已经被打开!"Exit SubEnd IfNextMsgBox "工作簿" & myWb & "没有被打开!"
End Sub

代码解析：
WorkbookIsOpen_1过程通过遍历当前应用程序中所有已打开的工作簿文件(Workbooks集合)，判断“Excel Home”工作簿是否打开。
第5行代码使用For…Each…Next语句来遍历Workbook对象集合中的所有元素。
第6行到第8行代码如果Workbook对象集合包含“Excel Home.xls”工作簿名称，说明文件已打开，使用Exit Sub语句结束代码的运行。
第11行代码如果运行到此行代码说明“Excel Home.xls”工作簿没有被打开。

43.2 错误处理方法

使用错误处理程序判断指定名称的工作簿是否打开，如下面的代码所示。

Sub WorkbookIsOpen_2()Dim Wb As WorkbookDim myWb As StringmyWb = "Excel Home.xls"Err.ClearOn Error GoTo lineSet Wb = Application.Workbooks(myWb)MsgBox "工作簿" & myWb & "已经被打开!"Set Wb = NothingExit Sub
line:MsgBox "工作簿" & myWb & "没有被打开!"Set Wb = Nothing
End Sub

代码解析：
WorkbookIsOpen_2过程使用错误处理程序判断“Excel Home”工作簿是否打开。
第5行代码使用Clear方法清除Err对象的所有属性设置。
第6行代启动错误处理程序，如果第7行代码发生错误则执行line行后面的代码。
第7行代码使用Set语句将Workbook对象引用赋给变量Wb，如果 “Excel Home.xls”工作簿没有被打开将发生下标越界错误，此时执行第12、13行代码，否则执行第8、9行代码。

44. 禁用宏则关闭工作簿

通常情况下，当应用程序的宏安全性的安全级别设置为“中”时，打开包含Microsoft Excel 4.0版的宏的工作簿，将显示如图 44 1所示的“安全警告”对话框。

图 44 1 安全警告对话框
如果用户选择“禁用宏”按钮，则会显示如图 44 2所示的警告消息框，当用户选择“否”时，不能打开该工作簿；用户选择“是”时，打开该工作簿，但VBA宏被禁止，而Microsoft Excel 4.0版的宏未被禁止。

图 44 2 Microsoft Excel 4.0宏警告对话框
我们可以利用禁用VBA宏不能禁止Microsoft Excel 4.0版的宏这个特点，使用Microsoft Excel 4.0版的宏来实现禁用宏则关闭工作簿的功能。
步骤1 新建或打开需要添加此项功能的工作簿文件。
步骤2 按<Ctrl+F11>组合键为工作簿添加一个宏表，添加的宏表名称默认为“Macro1”。
步骤3 在宏表“Macro1”的A1至A7单元格中输入下面的内容。

禁用宏则关闭工作簿
=ERROR(FALSE)
=IF(ERROR.TYPE(RUN("TestMacro"))=4)
=  ALERT("因禁用了宏功能,文件将被关闭!",3)
=  FILE.CLOSE(FALSE)
=END.IF()
=RETURN()

完成后的宏表如图 44 3所示。

图 44 3 完成输入后的宏表
代码解析：
Microsoft Excel 4.0宏函数以等号（=）开始，其他不是由等号开始的内容将被视作注释。通常用作定义的宏名称或者作为宏函数实现功能的注释内容设置为斜体字样以示区别，如图 44 3中单元格A1所示。
第2行代码关闭错误检查功能。如果关闭错误检查，那么当宏执行遇到错误时，Microsoft Excel 将不予理会而继续执行。
第3行到第6行代码使用If函数与End.If函数构成条件判断语句。其中，第3行中的语句通过检查宏函数RUN(“TestMacro”)的返回错误类型是否为4（禁用宏时的返回结果），判断工作簿是否禁用了宏功能。如果第3行的结果为True，则执行下面的语句。
在第4、5行代码，插入几个空格来表示相关代码之间的层次结构。第4行中的代码显示一个消息框。第5行中的代码关闭当前活动工作簿，设置参数值为Fasle表示关闭时工作簿时不保存对其所作的更改。
第7行代码终止当前代码的执行。Microsoft Excel 4.0宏要求每个宏必须使用RETURN或HALT函数结束。
步骤4 为每个表添加工作表级别的名称“Auto_Activate”，并将引用都指向宏表“Macro1”的A2单元格。“Auto_Activate”是一个自动宏，表被激活时自动执行。
添加工作表级别的名称的方法如下：选择一张工作表，假设为表“Sheet1”，单击菜单“插入”→“名称”→“定义名称”。在“定义名称”对话框中添加名称，如图 44 4所示。

图 44 4 定义工作表级别的名称
输入完成后单击“确定”按钮，完成一张工作表的“Auto_Activate”的定义。完成定义后的名称将在“定义名称”对话框中显示，如图 44 5所示。依次为每个表添加“Auto_Activate”名称。

图 44 5 名称对话框中的工作表级名称
此外，使用VBA也可以实现同样的操作，并且使用VBA的好处是能够隐藏名称，以避免名称被删除或修改。代码如下：

  Sub AddPrivateNames()Dim sht As ObjectFor Each sht In SheetsThisWorkbook.Names.Add sht.Name & "!Auto_Activate", _
"=Macro1!$A$2", FalseNextEnd Sub

步骤5 运行下面的代码，隐藏宏表工作表：

Sub HideMacroSheet()ThisWorkbook.Excel4MacroSheets(1).Visible = xlSheetHidden
End Sub

步骤6 保存工作簿。
当应用程序的宏安全性的安全级设置为“中”时，如果用户打开该工作簿文件并选择“禁用宏”，将显示如图 44 2所示的警告消息框。当用户选择“是”时，活动工作表上的自动宏“Auto_Activate”将被执行，执行结果显示如图 44 6所示的消息框，当用户选择“确定”按钮后，将强制关闭该工作簿文件。

图 44 6 警告消息框

45. 关闭工作簿不显示保存对话框

当用户更改工作簿后，没有进行保存操作而直接关闭工作簿时，将显示如图 45 1所示的消息框，提示用户是否保存对工作簿的更改，如果希望不显示该消息框而直接关闭关闭工作簿，可以在关闭时进行相应的设置。

图 45 1 提示保存对话框

45.1 使用Close方法关闭工作簿

使用Close方法关闭工作簿的，可以在Close方法中指定相应的参数，如下面的代码所示。

Sub wbClose_1()ThisWorkbook.Close SaveChanges:=False
End Sub

代码解析：
wbClose_1过程使用Close方法关闭工作簿，并放弃所有对工作簿的更改。
应用于Workbook对象的Close方法关闭对象，语法如下：

expression.Close(SaveChanges, Filename, RouteWorkbook)

其中SaveChanges参数是可选的，如果工作簿没有改变则忽略此参数；如果工作簿发生了改变并且在另外的窗口中也打开了该工作簿，则仍然忽略此参数；如果工作簿发生了改变并且没有在另外的窗口中打开，则此参数将指定是否在工作簿中保存所发生的更改。取值与操作如表格 45 1所示：
值 作用
True 将改变保存到工作簿。如果该工作簿尚未命名，则使用 FileName 指定的名称。如果省略 FileName 参数，则要求用户输入文件名。
False 不将改变保存到此文件。
省略 显示一个对话框，要求用户决定是否保存所做的更改。
表格 45 1 SaveChanges参数值的作用
如果希望在关闭工作簿时自动保存更改，将SaveChanges参数值设置为True即可。
还可以在使用Close方法关闭工作簿时设置Workbook对象的Saved属性，如下面的代码所示。

Sub wbClose_2()ThisWorkbook.Saved = TrueThisWorkbook.Close 
End Sub

代码解析：
wbClose_2过程使用Close方法关闭工作簿，并放弃所有对工作簿的更改。
Workbook对象的Saved属性指示工作簿从上次保存至今是否发生过更改，如果工作簿进行了更改，则该属性值为False，否则为True。应用程序在关闭工作簿之前判断该属性的值，如果其值为False，则显示提示是否保存的消息框，询问用户是否保存对工作簿所做的更改。
第2行代码将该属性的值设置为True，使Excel认为已经保存了对工作簿所作的更改（实际上没有保存更改），从而不再显示提示是否保存的消息框。
如果需要保存对工作簿所作的更改，那么应该在Close方法之前使用Save方法保存工作簿，代码如下：

Sub wbClose_3()ThisWorkbook.SaveThisWorkbook.Close 
End Sub

代码解析：
wbClose_3过程使用Save方法保存工作簿所做的更改，然后使用Close方法关闭工作簿。

45.2 单击工作簿关闭按钮关闭工作簿

如果是通过单击工作簿的关闭按钮等操作关闭工作簿的，则使用BeforeClose事件过程来控制，如下面的代码所示。

Private Sub Workbook_BeforeClose(Cancel As Boolean)Me.Saved = True
End Sub

代码解析：
工作簿的Workbook_BeforeClose事件，将工作簿的Saved属性设置为True，不保存更改而直接关闭工作簿，且不显示提示保存的消息框。
如果希望保存对工作簿的更改，则在Workbook_BeforeClose事件中使用Save方法保存工作簿，如下面的代码所示。

Private Sub Workbook_BeforeClose(Cancel As Boolean)Me.Save
End Sub

46. 禁用工作簿的关闭按钮

一般情况下，用户可以通过菜单“文件”→“关闭”、工作簿窗口右上角的“关闭窗口”按钮或者任务栏中图标右键菜单中的“关闭”菜单项关闭工作簿。如果希望禁用上述关闭工作簿的功能，而只能通过代码关闭工作簿，则可以在相应的工作簿事件中实现，如下面的代码所示。

Dim BClose As Boolean
Private Sub Workbook_BeforeClose(Cancel As Boolean)If BClose = False ThenCancel = TrueMsgBox "此功能已经被禁止，请使用""关闭""按钮关闭工作簿!", vbExclamation, "提示"End If
End Sub
Public Sub CloseWorkbook()BClose = TrueMe.Close
End Sub

代码解析：
第1行代码在模块顶部声明变量BClose为Boolean类型，默认初始值为False。
第2行到第7行代码工作簿的BeforeClose事件过程，通过变量BClose的当前值决定是否能够关闭工作簿，只有当BClose的值为True时，才允许关闭工作簿。如果变量BClose的值为False时将参数Cancel的值设置为True，以禁止关闭操作。
第8行到第11行代码CloseWorkbook过程，将变量BClose的当前值设置为True后使用Close方法关闭工作簿。关于Close方法请参阅技巧45-1。
在添加以上代码后，用户只能通过调用CloseWorkbook过程关闭工作簿。如果通过菜单“文件”→“关闭”或者单击工作簿窗口右上角的“关闭窗口”按钮关闭工作簿，将显示如图 46 1所示的消息框。

图 46 1 禁用关闭按钮

47. 保存工作簿的方法

47.1 使用Save方法

使用Workbook对象的Save方法保存工作簿的更改，如下面的代码所示。

Sub SaveWork()ThisWorkbook.Save
End Sub

代码解析：
SaveWork过程保存代码所在的工作簿的修改。
Save方法保存指定工作簿所做的更改，语法如下：

expression.Save

参数expression是必需的，该表达式返回一个Workbook对象。
如果是第一次保存工作簿，请使用SaveAs方法为该文件指定文件名，请参阅技巧47-2。

47.2 直接保存为另一文件名

如果需要将工作簿另存为另一个文件名，可以使用Workbook 对象的SaveAs 方法，如下面的代码所示。

Sub SaveAsWork()ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\123.xls"
End Sub

代码解析：
SaveAsWork过程将代码所在的工作簿保存为“123”工作簿文件。
Workbook对象的SaveAs方法使用另外一个不同的文件名保存对工作簿所做的更改，语法如下：

SaveAs(FileName,FileFormat,Password,WriteResPassword,ReadOnlyRecommended,CreateBackup,AccessMode,ConflictResolution,AddToMru,TextCodepage,TextVisualLayout,Local)

其中，参数Filename可选，表示要保存文件的文件名的字符串。可包含完整路径，如果不指定路径，将文件保存到当前文件夹中。
使用SaveAs方法将工作簿另存为新文件后，将关闭原工作簿文件。

47.3 保存工作簿副本

如果用户希望工作簿在保存为另一文件名后，能继续编辑原工作簿，那么可以使用SaveCopyAs 方法，如下面的代码所示。

	
Sub SaveCopyWork()ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\123.xls"
End Sub

代码解析：
SaveCopyWork 过程使用SaveCopyAs 方法保存代码所在的工作簿副本，并指定其名称。
SaveCopyAs 方法将指定工作簿的副本保存到文件，但不修改内存中的打开工作簿，语法如下：

SaveCopyAs(Filename)

参数Filename：必需的，用于指定工作簿副本的文件名。

48. 保存指定工作表为工作簿文件

如果需要将工作簿中的工作表单独保存为一个工作簿文件，可以使用Worksheet对象的Copy方法，将指定的工作表复制到一个新建的工作簿，如下面的代码所示。

Sub SheetCopy()
'第2行代码错误处理语句。备份过程中，如果已存在同名工作簿，会出现如所示的提示，如果选择了“否”或“取消”，此时新工作簿已经建立，在执行4行代码时发生错误，使程序中断，所以使用GoTo语句执行第7行代码，关闭新建立的工作簿并且不保存。On Error GoTo line
'第3行代码使用Copy方法新建一个工作簿，新工作簿中包含复制的工作表。应用于Worksheet对象的Copy方法将指定工作表复制到工作簿的另一位置ActiveSheet.Copy'第4行代码使用Workbook对象的Close方法关闭新建的工作簿。应用于Workbooks集合和Workbook对象的Close方法请参阅技巧45-1。ActiveWorkbook.Close SaveChanges:=True, Filename:=ThisWorkbook.Path & "\SheetCopy.xls"Exit Sub
line:ActiveWorkbook.Close False
End Sub

代码解析：
SheetCopy过程将活动工作表单独保存为一个工作簿文件。

语法如下：

Copy (Before, After)

参数Before：可选的，用来指定工作表，复制的工作表将置于此工作表之前。
参数After：可选的，用来指定工作表，复制的工作表将置于此工作表之后。
不能同时指定Before 参数和After 参数。
当Copy方法省略参数时，应用程序将新建一个空工作簿（新建工作簿将成为活动窗口），并将Copy方法引用的工作表复制到该空工作簿中。

如果需要将工作簿中的几个工作表单独保存为一个工作簿文件时，可以以数组的形式指定要复制的工作表，如下面的代码所示。

Sub ArrSheetCopy()On Error GoTo lineWorksheets(Array("Sheet1", "Sheet2")).CopyActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\ArrSheetCopy.xls"ActiveWorkbook.Close SaveChanges:=TrueExit Sub
line:ActiveWorkbook.Close False
End Sub

代码解析：
ArrSheetCopy过程将“Sheet1”和“Sheet2”工作表单独保存为一个工作簿文件。
第4行代码使用SaveAs方法保存活动工作簿，关于SaveAs方法请参阅技巧47-2。

49. 打印预览时不触发事件

在工作表打印之前或进行打印预览时，会触发工作簿的BeforePrint事件。在某些情况下希望在打印预览时能禁止触发该事件，例如如图 49 1所示的工作表中，用户在打印时使用下面的代码将流水号的数值自动加1。

Private Sub Workbook_BeforePrint(Cancel As Boolean)Sheet1.Range("J1") = Sheet1.Range("J1") + 1
End Sub

但是在打印预览时并不希望流水号的数值自动加1，此时，需要修改系统的打印预览功能，如下面的代码所示。

Private Sub Workbook_Open()Dim CmdCtrls As CommandBarControlsDim Cmd As CommandBarControlSet CmdCtrls = Application.CommandBars.FindControls(ID:=109)For Each Cmd In CmdCtrlsCmd.OnAction = "ThisWorkbook.MyPrint"Next
End Sub

代码解析：
工作簿的Open事件过程，在打开工作簿时，修改系统中所有打印预览命令按钮和菜单项的动作，指定其OnAction属性为ThisWorkbook代码窗口中的公用过程MyPrint。
第4行代码使用FindControls方法将所有打印预览命令按钮和菜单项赋给变量CmdCtrls，FindControls方法返回符合指定条件的CommandBarControls集合，语法如下：

expression.FindControls(Type, Id, Tag, Visible)

其中参数expression是必需的，该表达式返回一个CommandBars集合。
参数Id是可选的，要查找控件的标识符。打印预览命令控件的标识符为109。
第5行到第7行代码遍历所有打印预览命令控件，指定其OnAction属性为ThisWorkbook代码窗口中的公用过程MyPrint。OnAction属性返回或设置一个Visual Basic 的过程名，该过程在用户单击或更改某命令栏控件的值时运行。
MyPrint过程代码如下：

Public Sub MyPrint()With Application.EnableEvents = False.ActiveSheet.PrintPreview EnableChanges:=False.EnableEvents = TrueEnd With
End Sub

代码解析：
MyPrint过程通过禁止对象事件，使工作表打印预览时不触发工作簿的BeforePrint事件。
第3行代码将Application对象的EnableEvents属性设置为False，禁用事件，使事件不能触发。
第4行代码使用PrintPreview方法对工作表执行打印预览。PrintPreview方法以打印效果显示指定的对象，该方法只有一个参数EnableChanges，用来指定是否可以修改页面设置，当其值为False时，禁止在打印预览时修改页面设置，默认值为True。
第5行代码将Application对象的EnableEvents属性设置为True，启用事件。
为了在工作簿时恢复默认的打印预览设置，在ThisWorkbook代码窗口写入以下代码：

Private Sub Workbook_BeforeClose(Cancel As Boolean)Dim CmdCtrls As CommandBarControlsDim Cmd As CommandBarControlSet CmdCtrls = Application.CommandBars.FindControls(ID:=109)For Each Cmd In CmdCtrlsCmd.OnAction = ""Next
End Sub

代码解析：
工作簿的BeforeClose事件过程，关闭工作簿时将所有打印预览命令按钮和菜单项的OnAction属性恢复为默认的动作。
经过以上设置，工作表只有在进行打印时“流水号”数值才自动加1。

50. 设置工作簿文档属性信息

使用DocumentProperties集合对象的BuiltinDocumentProperties属性可以设置文档的属性信息，如下面的代码所示。

Sub WbBuiltin()With ThisWorkbook.BuiltinDocumentProperties("Title") = "Wordbook（工作簿）对象".BuiltinDocumentProperties("Subject") = "设置工作簿的文档属性信息".BuiltinDocumentProperties("Author") = "yuanzhuping".BuiltinDocumentProperties("Company") = "tzzls".BuiltinDocumentProperties("Comments") = "工作簿文档属性信息".BuiltinDocumentProperties("Keywords") = "Excel VBA"End WithMsgBox "工作簿文档属性信息设置完毕！"
End Sub

代码解析：
WbBuiltin过程设置代码所在工作簿的属性信息，应用于Workbook对象的BuiltinDocumentProperties属性返回一个DocumentProperties集合，该集合代表指定工作簿的所有内置文档属性，本属性返回的是内置文档属性的整个集合。通过指定属性的名称或集合中的索引号返回集合中的单个成员（一个DocumentProperty对象）。
第3行代码设置标题，第4行代码设置主题，第5行代码设置作者，第6行代码设置公司，第7行代码设置备注，第8行代码设置关键字。
工作簿文档属性信息设置如图 50 1所示。

图 50 1 工作簿文档属性信息

51. 不打开工作簿取得其他工作簿数据

在Excel的使用过程中，经常需要引用其他工作簿的数据，而用户往往希望能在不打开工作簿或看似不打开工作簿的情况下取得其他工作簿中的数据，有以下几种方法可以实现。

51.1 使用公式

如果需要引用的数据不是太多，可以使用公式取得引用工作簿中的工作表数据，如下面的代码所示。

Sub CopyData_1()Dim Temp As StringTemp = "'" & ThisWorkbook.Path & "\[数据表.xls]Sheet1'!"With Sheet1.Range("A1:F22").FormulaR1C1 = "=" & Temp & "RC".Value = .ValueEnd With
End Sub

代码解析：
CopyData_1过程在工作表中写入公式引用“数据表”中同一位置单元格中的数据。
第3行代码将引用工作簿的路径赋给变量Temp。
第5行代码在作表中写入公式引用数据。
第6行代码将公式转换为数值。

51.2 使用GetObject函数

使用GetObject函数来获取对指定的Excel工作表的引用，如下面的代码所示。

Sub CopyData_2()Dim Wb As WorkbookDim Temp As StringApplication.ScreenUpdating = FalseTemp = ThisWorkbook.Path & "\数据表.xls"Set Wb = GetObject(Temp)With Wb.Sheets(1).Range("A1").CurrentRegionRange("A1").Resize(.Rows.Count, .Columns.Count) = .ValueWb.Close FalseEnd WithSet Wb = NothingApplication.ScreenUpdating = True
End Sub

代码解析：
CopyData_2过程使用GetObject函数来获取“数据表”工作簿中的数据。
第4行代码关闭屏幕更新加快运行速度。
第5行代码将引用工作簿的路径赋给变量Temp。
第6行代码使用Set语句将GetObject函数返回的对象赋给对象变量Wb。
GetObject函数返回文件中的ActiveX对象的引用，语法如下：

GetObject([pathname] [, class])

参数pathname是可选的，包含待检索对象的文件的全路径和名称。如果省略，则class参数是必需的。
参数class是可选的，代表该对象的类的字符串。
Class参数的格式为appname.objecttype，语法的各个部分如表格 51 1所示。
部分 描述
appname 必需的，提供该对象的应用程序名称。
objecttype 必需的，待创建对象的类型或类。
表格 51 1 Class参数语法的各个部分
第7行到第10行代码，当GetObject函数指定的对象被激活之后，就可以在代码中使用对象变量Wb来访问这个对象的属性和方法。
其中第7、8行代码将“数据表”工作簿中的第1张工作表已使用区域的数据赋给本工作表的单元格，第9行代码关闭“数据表”工作簿，使用GetObject函数返回对象的引用时，虽然在窗口中看不到对象的实例，但实际上是打开的，所以需用Close语句将其关闭。
第12行代码开启屏幕更新。

51.3 隐藏Application对象

通过隐藏Application对象来模拟不打开工作簿取数，如下面的代码所示。

Sub CopyData_3()Dim myApp As New ApplicationDim Sh As WorksheetDim Temp As StringTemp = ThisWorkbook.Path & "\数据表.xls"myApp.Visible = FalseSet Sh = myApp.Workbooks.Open(Temp).Sheets(1)With Sh.Range("A1").CurrentRegionRange("A1").Resize(.Rows.Count, .Columns.Count) = .ValueEnd WithmyApp.QuitSet Sh = NothingSet myApp = Nothing
End Sub

代码解析：
CopyData_3过程隐藏Application对象来模拟不打开工作簿取数。
第2行代码使用New关键字隐式地创建一个Application对象。
第6行代码将新创建的Application对象的Visible属性设置为False，使之隐藏。
第7行代码使用Open方法打开“数据表”工作簿（关于Open方法请参阅技巧42 ，因为工作簿是使用新创建的、隐藏的Application对象打开的，所以在窗口中是不可视的。
第8行到第10行代码将“数据表”工作簿中的第1张工作表已使用区域的数据赋给本工作表的单元格。
第11行代码使用Quit方法退出新打开的Excel程序。
51-4 使用ExecuteExcel4Macro方法
使用ExecuteExcel4Macro方法可以做到不打开工作簿的情况下获取其他工作薄中指定工作表的数据，如下面的代码所示。

Sub CopyData_4()Dim RCount As LongDim CCount As LongDim Temp As StringDim Temp1 As StringDim Temp2 As StringDim Temp3 As StringDim R As LongDim C As LongDim arr() As VariantTemp = "'" & ThisWorkbook.Path & "\[数据表.xls]Sheet1'!"Temp1 = Temp & Rows(1).Address(, , xlR1C1)Temp1 = "Counta(" & Temp1 & ")"CCount = Application.ExecuteExcel4Macro(Temp1)Temp2 = Temp & Columns("A").Address(, , xlR1C1)Temp2 = "Counta(" & Temp2 & ")"RCount = Application.ExecuteExcel4Macro(Temp2)ReDim arr(1 To RCount, 1 To CCount)For R = 1 To RCountFor C = 1 To CCountTemp3 = Temp & Cells(R, C).Address(, , xlR1C1)arr(R, C) = Application.ExecuteExcel4Macro(Temp3)NextNextRange("A1").Resize(RCount, CCount).Value = arr
End Sub

代码解析：
CopyData_4过程使用ExecuteExcel4Macro方法获取“数据表”工作薄中指定工作表的数据。
第14、16行代码使用ExecuteExcel4Macro方法执行Counta函数取得“数据表”工作薄中指定工作表的行数和列数合计。
ExecuteExcel4Macro方法执行一个Microsoft Excel 4.0宏函数，然后返回此函数的结果，语法如下：

expression.ExecuteExcel4Macro(String)

参数expression是可选的，返回一个Application对象。
参数String是必需的，一个不带等号的Microsoft Excel 4.0宏语言函数，所有引用必须是像R1C1这样的字符串。
因为Microsoft Excel 4.0 宏不在当前工作簿或工作表的环境中求值，所有的引用都是外部引用，所以无需打开引用工作簿但是需要明确指定工作簿名称。
第18行代码使用ReDim语句为动态数组arr重新分配存储空间。
第19行到第24行代码循环取值，将“数据表”工作薄中指定工作表的数据赋给动态数组arr。
第25行代码将动态数组arr的值赋给工作表的单元格。

51.5 使用SQL连接

使用SQL建立与工作簿的连接，查询数据记录后复制到当前工作表中，如下面的代码所示。

Sub CopyData_5()Dim Sql As StringDim j As IntegerDim R As IntegerDim Cnn As ADODB.ConnectionDim rs As ADODB.RecordsetWith Sheet5.Cells.ClearSet Cnn = New ADODB.ConnectionWith Cnn.Provider = "microsoft.jet.oledb.4.0".ConnectionString = "Extended Properties=Excel 8.0;" _& "Data Source=" & ThisWorkbook.Path & "\数据表".OpenEnd WithSet rs = New ADODB.RecordsetSql = "select * from [Sheet1$]"rs.Open Sql, Cnn, adOpenKeyset, adLockOptimisticFor j = 0 To rs.Fields.Count - 1.Cells(1, j + 1) = rs.Fields(j).NameNextR = .Range("A65536").End(xlUp).Row.Range("A" & R + 1).CopyFromRecordset rsEnd Withrs.CloseCnn.CloseSet rs = NothingSet Cnn = Nothing
End Sub

代码解析：
CopyData_5过程使建立与“数据表”工作簿的连接，查询数据记录后复制到当前工作表中。
第8行代码删除当前工作表的所有数据。
第9行到第15行代码建立与“数据表”工作簿的连接。
第16行到第24行代码查询“数据表”工作簿的全部数据，并复制到工作表中。其中第20行代码将字段名称（标题行）复制到工作表中，第23行代码将查询到的数据记录复制到工作表。

52. 返回窗口的可视区域地址

VBA中使用VisibleRange属性返回当前窗口的可视区域，如下面的代码所示。

Sub VbRange()Dim s As Strings = ActiveWindow.VisibleRange.Address(0, 0)MsgBox "窗口的可视区域为：" & s
End Sub

代码解析：
VbRange过程使用消息框显示当前窗口的可视区域的地址。
应用于当前Window对象的VisibleRange属性返回一个Range对象，代表当前窗口的可视区域。窗口的可视区域就是用户可以在窗口或窗格中看到的单元格区域，如果行或列部分可见，该行或列也包括在可视区域中。
因为VisibleRange属性返回的是一个Range对象，因此可以直接使用该对象的属性和方法。
当窗口的大小发生变化时，返回的可视区域的地址也会不同，如图 52 1、图 52 2所示。

图 52 1 自定义大小的窗口

图 52 2 最大化时的窗口

第四章 Shape（图形）、Chart（图表）对象

53. 在工作表中添加图形

如果需要在工作表中添加图形对象，可以使用AddShape 方法，如下面的代码所示。

Sub AddShape()'声明变量 myShape 的对象类型。Dim myShape As Shape'删除可能存在的名称为“myShape”的图形对象。On Error Resume NextSheet1.Shapes("myShape").Delete'使用AddShape 方法在工作表中添加一个矩形。Set myShape = Sheet1.Shapes.AddShape(msoShapeRectangle, 40, 120, 280, 30)With myShape'将新建图形命名为“myShape”，向Shapes集合添加新的图形时，将对新添加的图形赋以默认的名称，若要为图形指定更有意义的名称，可指定其Name属性。.Name = "myShape"'为矩形添加文字，并设定其格式。With .TextFrame.Characters'为矩形添加文字，应用于Characters对象的Text属性返回或设置对象的文本，为可读写的String类型。.Text = "单击将选择Sheet2!"With .Font.Name = "华文行楷".FontStyle = "常规".Size = 22.ColorIndex = 7End WithEnd WithWith .TextFrame.HorizontalAlignment = -4108.VerticalAlignment = -4108End With.Placement = 3End WithmyShape.SelectWith Selection.ShapeRangeWith .Line.Weight = 1.DashStyle = msoLineSolid.Style = msoLineSingle.Transparency = 0.Visible = msoTrue.ForeColor.SchemeColor = 40.BackColor.RGB = RGB(255, 255, 255)End WithWith .Fill.Transparency = 0.Visible = msoTrue.ForeColor.SchemeColor = 41.OneColorGradient 1, 4, 0.23End WithEnd WithSheet1.Range("A1").Select'为矩形对象添加超链接Sheet1.Hyperlinks.Add Anchor:=myShape, Address:="", _SubAddress:="Sheet2!A1", ScreenTip:="选择Sheet2!"Set myShape = Nothing
End Sub

代码解析：
AddShape 过程在工作表中添加一个矩形并设置其外观等属性。
语法如下：

expression.AddShape(Type, Left, Top, Width, Height)

• 参数 expression 是必需的，返回一个Shapes对象。
• 参数 Type 是必需的，指定要创建的自选图形的类型。
• 参数 Left 和 Top 是必需的，以磅为单位给出自选图形边框左上角的位置。
• 参数 Width 和 Height 是必需的，以磅为单位给出自选图形边框的宽度和高度。

Characters方法返回一个Characters对象，该对象代表某个图形的文本框中的字符区域，语法如下：

expression.Characters(Start, Length)

• 参数 expression 是必需的，返回一个指定文本框内Characters对象的表达式。
• 参数 Start 是可选的，表示将要返回的第一个字符，如果此参数设置为 1 或被忽略，则Characters方法会返回以第一个字符为起始字符的字符区域。
• 参数 Length 是可选的，表示要返回的字符个数。如果此参数被忽略，则Characters方法会返回该字符串的剩余部分（由Start参数指定的字符以后的所有字符）。

应用于TextFrame对象的HorizontalAlignment属性返回或设置指定对象的水平对齐方式，可为下表所示的XlHAlign常量之一。

常量	值	描述
xlHAlignCenter	-4108	居中
xlHAlignCenterAcrossSelection	7	靠左
xlHAlignDistributed	-4117	分散对齐
xlHAlignFill	5	分散对齐
xlHAlignGeneral	1	靠左
xlHAlignJustify	-4130	两端对齐
xlHAlignLeft	-4131	靠左
xlHAlignRight	-4152	靠右

应用于TextFrame对象的VerticalAlignment属性返回或设置指定对象的垂直对齐方式，可为下表所示的XlHAlign常量之一。

常量	值	描述
xlVAlignCenter	-4108	居中
xlVAlignJustify	-4130	两端对齐
xlVAlignBottom	-4107	靠下
xlVAlignDistributed	-4117	分散对齐
xlVAlignTop	-4160	靠上

第21行代码设置矩形大小和位置不随单元格而变，应用于Shape对象的Placement属性返回或设置对象与所在的单元格之间的附属关系，可为表格 53 3所示的XlPlacement常量之一。

常量	值	描述
xlFreeFloating	3	大小、位置均固定
xlMove	2	大小固定、位置随单元格而变
xlMoveAndSize	1	大小、位置随单元格而变

第24行到第32行代码设置矩形的边框线条格式，应用于ShapeRange集合的Line属性返回一个LineFormat 对象，该对象包含指定图形的线条格式属性。
其中第26行代码设置矩形线条粗细，第27行代码设置矩形线条的虚线样式，第28行代码设置矩形填充的透明度，第29行代码设置矩形为可见，第30行代码设置矩形的前景色，第31行代码设置矩形填充背景的颜色。
第33行到第38行代码设置矩形的内部填充格式，应用于ShapeRange集合的Fill属性返回FillFormat对象，该对象包含指定的图表或图形的填充格式属性。
其中第35行代码设置矩形内部的透明度，第36行代码设置矩形内部为可见，第37行代码设置矩形内部的前景色，第38行代码将矩形内部指定填充设为单色渐变，应用于 FillFormat对象的OneColorGradient方法将指定填充设为单色渐变，语法如下：

expression.OneColorGradient(Style, Variant, Degree)

其中参数Style是必需的，底纹样式，可为表格 54 1所示的MsoGradientStyle常量之一。

常量	值	描述
msoGradientDiagonalDown	4	斜下
msoGradientDiagonalUp	3	斜上
msoGradientFromCenter	7	无
msoGradientFromCorner	5	角部幅射
msoGradientFromTitle	6	中心幅射
msoGradientHorizontal	1	水平
msoGradientMixed	-2	无
msoGradientVertical	2	垂直

表格 53 4 MsoGradientStyle常量

• 参数Variant是必需的，渐变变量。取值范围为 1 到 4 之间，分别与“填充效果”对话框中“渐变”选项卡的四个渐变变量相对应。如果GradientStyle 设为 msoGradientFromCenter，则Variant参数只能设为 1 或 2。
• 参数Degree是必需的，灰度。取值范围为 0.0（表示最深）到 1.0（表示最浅）之间。
  第42、43行代码为矩形对象添加超链接，应用于Hyperlinks对象的Add方法向指定的区域或图形添加超链接，语法如下：

expression.Add(Anchor, Address, SubAddress, ScreenTip, TextToDisplay)

• 参数expression是必需的，返回一个Hyperlinks对象。
• 参数Anchor是必需的，超链接的位置。可为Range对象或Shape对象。
• 参数Address是必需的，超链接的地址。
• 参数SubAddress是必需的，超链接的子地址。
• 参数ScreenTip是可选的，当鼠标指针停留在超链接上时所显示的屏幕提示。
• 参数TextToDisplay是可选的，要显示的超链接的文本。

运行AddShape过程结果如下图所示。

54. 导出工作表中的图片

有时需要将工作表中的图形对象保存为单独的图像文件，可以使用Export方法将工作表中的图片以文件形式导出，如下面的代码所示。

Sub ExportShp()Dim Shp As ShapeDim FileName As StringFor Each Shp In Sheet1.ShapesIf Shp.Type = msoPicture ThenFileName = ThisWorkbook.Path & "\" & Shp.Name & ".gif"Shp.CopyWith Sheet1.ChartObjects.Add(0, 0, Shp.Width + 28, Shp.Height + 30).Chart.Paste.Export FileName, "gif".Parent.DeleteEnd WithEnd IfNext
End Sub

代码解析：
ExportShp过程将Sheet1工作表的所有图片以文件形式导出到同一目录中。
第4行代码使用For Each…Next 语句遍历Sheet1工作表中的所有图形。
第5行代码判断图形的类型是否为图片，应用于Shape对象的Type属性返回或设置图形类型，可以为表格 54 1所示的MsoShapeType常量之一。

常量	值	说明
msoShapeTypeMixed	-2	混合型图形
msoAutoShape	1	自选图形
msoCallout	2	没有边框线的标注
msoChart	3	图表
msoComment	4	批注
msoFreeform	5	任意多边形
msoGroup	6	图形组合
msoFormControl	8	窗体控件
msoLine	9	线条
msoLinkedOLEObject	10	链接式或内嵌OLE对象
msoLinkedPicture	11	剪贴画或图片
msoOLEControlObject	12	ActiveX 控件
msoPicture	13	图片
msoTextEffect	15	艺术字
msoTextBox	17	文本框
msoDiagram	21	组织结构图或其他图示

表格 54 1 MsoShapeType常量
第6行代码使用字符串变量FileName记录需导出图形的路径和名称。
第7行代码复制图形，应用于Shape对象的Copy方法将对象复制到剪贴板。
第8行代码使用Add方法在工作表中添加一个图表，应用于ChartObjects对象的Add 方法创建新的嵌入图表，语法如下：

expression.Add(Left, Top, Width, Height)

参数expression是必需的，返回一个ChartObjects对象。
参数Left、参数Top是必需的，以磅为单位给出新对象的初始坐标，该坐标是相对于工作表上单元格A1的左上角或图表的左上角的坐标。
参数Width、参数Height是必需的，以磅为单位给出新对象的初始大小。
第9行代码使用Paste方法将图形粘贴到新的嵌入图表中，应用于Chart对象的Paste方法将剪贴板中的图表数据粘贴到指定的图表中，语法如下：

expression.Paste(Type)

参数expression是必需的，返回一个Chart对象。
参数Type是可选的的，如果剪贴板中有图表，本参数指定要粘贴的图表信息。可为以下XlPasteType常量之一：xlFormats、xlFormulas或xlAll。默认值为xlAll，如果剪贴板中是数据不是图表，则不能使用本参数。
第10行代码使用Export方法将图表导出到同一目录中，应用于Chart对象的Export方法以图形格式导出图表，语法如下：

expression.Export(Filename, FilterName, Interactive)

其中参数Filename是必需的，被导出的文件的名称。
第10行代码删除新建的图表。因为Chart对象是不能使用Delete方法直接删除的，应先使用Parent属性返回指定对象的父对象，然后使用Delete方法删除。

55. 在工作表中添加艺术字

在工作表中插入艺术字，可以使用AddTextEffect方法，如下面的代码所示。

Sub TextEffect()Dim myShape As Shape'第3、4行代码删除工作表中可能存在的艺术字，以免重复添加。On Error Resume NextSheet1.Shapes("myShape").DeleteSet myShape = Sheet1.Shapes.AddTextEffect _(PresetTextEffect:=msoTextEffect15, _Text:="我爱 Excel Home", FontName:="宋体", FontSize:=36, _FontBold:=msoFalse, FontItalic:=msoFalse, _Left:=100, Top:=100)With myShape'将艺术字对象重命名为“myShape”。.Name = "myShape"With .Fill.Solid.ForeColor.SchemeColor = 55.Transparency = 0End WithWith .Line.Weight = 1.5.DashStyle = msoLineSolid.Style = msoLineSingle.Transparency = 0.ForeColor.SchemeColor = 12.BackColor.RGB = RGB(255, 255, 255)End WithEnd WithSet myShape = Nothing
End Sub

代码解析：
TextEffect 过程在工作表中插入艺术字并设置其格式。

第5行到第9行代码使用AddTextEffect方法在工作表中插入艺术字，AddTextEffect方法创建艺术字对象。返回一个Shape对象，该对象代表新建的艺术字对象，语法如下：

expression.AddTextEffect(PresetTextEffect, Text, FontName, FontSize, FontBold, FontItalic, Left, Top)

• 参数expression是必需的，返回一个Shapes对象。
• 参数PresetTextEffect是必需的，艺术字预置文本效果，可为MsoPresetTextEffect 常量之一，等同于在工作表中插入艺术字时的样式选项卡，如图 55 1所示。

图 55 1 艺术字样式

• 参数Text是必需的，艺术字对象中的文字。
• 参数FontName是必需的，艺术字对象中所用的字体名称。
• 参数FontSize是必需的，以磅为单位给出艺术字对象中所用的字体大小。
• 参数FontBold是必需的，在艺术字中要加粗的字体。
• 参数FontItalic是必需的，在艺术字中要倾斜的字体。
• 参数Left和参数Top是必需的，相对于文档的左上角、顶部，以磅为单位给出艺术字对象边框左上角的位置。

第12行到第16行代码设置艺术字对象的填充格式。其中第13行代码将填充格式设置为均一的颜色，应用于FillFormat 对象的Solid方法将指定的填充格式设置为均一的颜色，可用本方法将带有渐进色、纹理、图案或背景的填充格式转换为单色的填充格式。第14行代码设置填充的颜色。第15行代码设置填充的透明度。
第17行到第24行代码设置艺术字对象的线条格式属性。其中第18行代码设置线条粗细，第19行代码设置线条虚线样式，第20行代码设置线条区域的样式，第21行代码设置线条的透明度，第22行代码设置前景色，第23行代码设置填充背景的颜色。
运行TextEffect过程工作表中如图 55 2所示。

56. 遍历工作表中的图形

工作表中的多个图形，如果使用系统缺省名称，如“文本框1”、“文本框2”这样前面是固定的字符串，后面是序号的，可以使用For…Next 语句遍历图形，如下面的代码所示。

Sub ErgShapes_1()Dim i As IntegerFor i = 1 To 4Sheet1.Shapes("文本框 " & i).TextFrame.Characters.Text = ""Next
End Sub

代码解析：
ErgShapes_1过程清除工作表中四个图形文本框中的文字。
第3行到第5行代码，使用Shapes属性在工作表上的三个图形文本框中循环。
Shapes属性返回Shapes对象，代表工作表或图形工作表上的所有图形，可以使用Shapes（index）返回单个的Shape对象，其中index是图形的名称或索引号。
返回单个的Shape对象后使用TextFrame 属性和Characters方法清除文本框中的字符，关于Shape对象的TextFrame 属性和Characters方法请参阅技巧53 。
如果图形的名称没有规律，可以使用For Each…Next 语句循环遍历所有图形，根据Type属性返回的图形类型进行相应的操作，如下面的代码所示。

Sub ErgShapes_2()Dim myShape As ShapeDim i As Integeri = 1For Each myShape In Sheet1.ShapesIf myShape.Type = msoTextBox ThenmyShape.TextFrame.Characters.Text = "这是第" & i & "个文本框"i = i + 1End IfNext
End Sub

代码解析：
ErgShapes_2过程在工作表中的所有图形文本框中写入文本。
第5行代码使用For Each…Next 语句循环遍历工作表中所有的图形对象。
第6行到第9行代码如果图形对象是文本框则在文本框中写入文本。其中第6行代码根据Type属性判断图形对象是否为文本框，应用于Shape对象的Type属性返回或设置图形类型，MsoShapeType类型，请参阅表格 54 1 。
第7行代码根据返回的Type属性值在所有的文本框内写入相应的文本，如图 56 1所示。

图 56 1 遍历所有的文本框

57. 移动、旋转图片

工作表中的图片可以移动、旋转，如下面的代码所示。

Sub MoveShape()Dim i As LongDim j As LongWith Sheet1.Shapes(1)For i = 1 To 3000 Step 5.Top = Sin(i * (3.1416 / 180)) * 100 + 100.Left = Cos(i * (3.1416 / 180)) * 100 + 100.Fill.ForeColor.RGB = i * 100For j = 1 To 10.IncrementRotation -2DoEventsNextNextEnd With
End Sub

代码解析：
MoveShape过程移动、旋转工作表中的图片并不断改变其填充的前景色。
第6行代码设置图片的Top属性值，应用于Shape对象的Top属性设置图形的顶端到工作表顶端的距离。在循环的过程中使用Sin函数将Top属性值设置为一个圆形的弧度值。Sin函数返回指定参数的正弦值，语法如下：

Sin(number)

参数number表示一个以弧度为单位的角。
Sin函数取一角度为参数值，并返回角的对边长度除以斜边长度的比值，将角度除以180后即能角度转换为弧度。
第7行代码设置图片的Left属性值，应用于Shape对象的Left属性设置图形从左边界至 A 列左边界（在工作表中）或图表区左边界（在图表工作表中）的距离。在循环的过程中使用Cos函数将Left属性值设置为一个圆形的弧度值。Cos函数返回指定一个角的余弦值，语法如下：

Cos(number)

参数number表示一个以弧度为单位的角。
Cos函数的number参数为一个角，并返回直角三角形两边的比值，该比值为角的邻边长度除以斜边长度之商，将角度除以180后即能角度转换为弧度。
第8行代码设置图片填充的前景色随着循环的过程不断的变化。使用Fill属性返回一个FillFormat对象，FillFormat对象代表图形的填充格式，其ForeColor 属性设置对象填充的前景色。
第9行到第11行代码在图形移动的过程中使用IncrementRotation方法设置图形绕 z 轴的转角，IncrementRotation方法以指定的度数为增量，更改指定的图形绕 z 轴的转角，语法如下：

expression.IncrementRotation(Increment)

• 参数expression是必需的，返回一个Shape对象。
• 参数Increment是必需的，以度为单位指定图形在水平方向的旋转量，正值使图形按顺时针方向旋转，负值使图形按逆时针方向旋转。
  其中第11行是关键的代码，使用DoEvents函数转让控制权，否则达不到预计的视觉效果。
  运行MoveShape过程，工作表的图形在自身进行逆时针方向旋转的同时沿着一个圆形的弧度进行移动，并不断改变其填充的颜色。

58. 工作表中自动插入图片

在日常工作中经常需要在工作表中插入大量图片，比如在如图 58 1所示的工作表中需要根据A列的名称在C列插入保存在同一目录中的相应的图片，如果使用手工插入不仅非常繁琐且极易出错，而使用VBA代码可以很好的完成操作。

图 58 1 需插入图片的工作表
示例代码如下：

Sub insertPic()Dim i As IntegerDim FilPath As StringDim rng As RangeDim s As StringWith Sheet1For i = 3 To .Range("a65536").End(xlUp).RowFilPath = ThisWorkbook.Path & "\" & .Cells(i, 1).Text & ".jpg"If Dir(FilPath) <> "" Then.Pictures.Insert(FilPath).SelectSet rng = .Cells(i, 3)With Selection.Top = rng.Top + 1.Left = rng.Left + 1.Width = rng.Width - 1.Height = rng.Height - 1End WithElses = s & Chr(10) & .Cells(i, 1).TextEnd IfNext.Cells(3, 1).SelectEnd WithIf s <> "" ThenMsgBox s & Chr(10) & "没有照片!"End If
End Sub

代码解析：
insertPic过程使用Insert方法在工作表中插入图片。
第7行代码开始For…Next循环，循环的终值由工作表中A列单元格的行数所决定。
第8行代码字符串变量FilPath保存A列名称单元格所对应的图片文件的路径和文件名，本例中图片文件的文件名应和A列中的名称一致。
第9行到第11行代码使用Dir函数在同一文件夹中查找与A列单元格中的名称相对应的图片文件，如果对应的图片文件存在则使用Insert方法将图片插入到工作表中，并将C列的单元格赋给变量rng。
Dir函数返回一个String，用以表示一个文件名、目录名或文件夹名称，它必须与指定的模式或文件属性、或磁盘卷标相匹配。如果已没有合乎条件的文件，则Dir函数会返回一个零长度字符串 (“”)。
第12行到第17行代码，当图片片插入到工作表时其实是插入到活动单元格的，此时需设置图片的Top属性和Left属性将图片移动到C列所对应的单元格中，并设置其Width属性和Height属性使其适应所在单元格的大小。
第18、19行代码如果在同一文件夹中没有与A列单元格对应的图片文件，则使用字符串变量s保存没有图片文件的名称。
第24行到第26行代码如果字符串变量s不等于空白说明文件夹中缺少图片文件，使用消息框提示。
运行insertPic过程工作表如图 58 2所示。

图 58 2 插入图片后的工作表
如果文件夹中缺少对应的图片文件，则会进行提示，如图 58 3所示。

图 58 3 缺少图片文件提示

59. 固定工作表中图形的位置

工作表中插入的图片，一般都是固定的尺寸和固定的单元格区域中的，但在实际使用中可能因一些人为的因素导致图片位置偏移或尺寸变化，此时可以使用VBA代码进行调整，如下面的代码所示。

Sub ShapeAddress()Dim rng As RangeSet rng = Sheet1.Range("B4:E22")With Sheet1.Shapes("Picture 1").Rotation = 0.SelectWith Selection.Top = rng(1).Top + 1.Left = rng(1).Left + 1.Width = rng.Width - 0.5.Height = rng.Height - 0.5End WithEnd WithRange("A1").Select
End Sub

代码解析：
ShapeAddress过程调整指定图形在工作表中的位置。
第3行代码变量rng保存工作表中插入图片的单元格区域。。
第5行代码设置图片的转角，应用于Shape对象Rotation属性以度为单位返回或设置图形的转角，设置为正值向右偏转，设置为负值向左偏转，设置为零图片则保持90度垂直。
第7行到第12行代码设置图片的Top属性和Left属性将图片移动到变量rng所保存的单元格区域中，并设置其Width属性和Height属性使其适应所在单元格区域的大小。
第14行代码选择A1单元格，不然图片会处于选中状态。
经过以上设置，工作表中的图片“Picture 1”不管处于什么状态都可以一键恢复其原来的大小、位置。

60. 使用VBA自动生成图表

在实际工作中我们常用图表来表现数据间的某种相对关系，一般采用手工插入的方式，而使用VBA代码可以在工作表中自动生成图表，如下面的示例代码。

Sub ChartAdd()Dim myRange As RangeDim myChart As ChartObjectDim R As IntegerWith Sheet1.ChartObjects.DeleteR = .Range("A65536").End(xlUp).RowSet myRange = .Range("A" & 1 & ":B" & R)Set myChart = .ChartObjects.Add(120, 40, 400, 250)With myChart.Chart.ChartType = xlColumnClustered.SetSourceData Source:=myRange, PlotBy:=xlColumns.ApplyDataLabels ShowValue:=True.HasTitle = True.ChartTitle.Text = "图表制作示例"With .ChartTitle.Font.Size = 20.ColorIndex = 3.Name = "华文新魏"End WithWith .ChartArea.Interior.ColorIndex = 8.PatternColorIndex = 1.Pattern = xlSolidEnd WithWith .PlotArea.Interior.ColorIndex = 35.PatternColorIndex = 1.Pattern = xlSolidEnd With.SeriesCollection(1).DataLabels.DeleteWith .SeriesCollection(2).DataLabels.Font.Size = 10.ColorIndex = 5End WithEnd WithEnd WithSet myRange = NothingSet myChart = Nothing
End Sub

代码解析：
ChartAdd过程在工作表中自动生成图表，图表类型为簇状柱形图。
第6行代码使用Delete方法删除工作表中已经存在的图表，而ChartObjects方法返回代表工作表中单个嵌入图表（ChartObject对象）或所有嵌入图表的集合（ChartObjects对象）的对象，语法如下：

expression.ChartObjects(Index)

其中参数Index是可选的，指定图表的名称或号码。该参数可以是数组，用于指定多个图表，因为示例中只有一个图表，所以无需指定其Index参数。
第8行代码指定图表的数据源。
第9行代码使用Add方法创建一个新图表，应用于ChartObjects对象的Add方法创建新的嵌入图表，语法如下：

expression.Add(Left, Top, Width, Height)

参数Left、Top是必需的，以磅为单位给出新对象的初始坐标，该坐标是相对于工作表上单元格A1的左上角或图表的左上角的坐标。
参数Width、Height是必需，以磅为单位给出新对象的初始大小。
第10行代码使用Chart属性返回新创建的图表，应用于ChartObject对象的Chart属性返回一个Chart对象，该对象代表指定对象所包含的图表。
第11行代码指定新创建图表的图表类型，应用于Chart对象的ChartType属性返回或设置图表的类型，可以为XlChartType常量之一，具体请参阅VBA帮助。本例中设置为xlColumnClustered即图表类型为簇状柱形图。
第12行代码指定图表的数据源和绘图方式，应用于Chart对象的SetSourceData方法为指定图表设置源数据区域，语法如下：

expression.SetSourceData(Source, PlotBy)

• 参数expression是必需的，该表达式返回一个Chart对象。
• 参数Source是可选的，源数据的区域。
• 参数PlotBy是可选的，指定数据绘制方式，可为xlColumns（系列产生在列）或xlRows（系列产生在行）。
  第13行代码使用ApplyDataLabels方法使图表显示数据标签和数据点的值，应用于Chart对象的ApplyDataLabels方法将数据标签应用于图表中的某一数据点、某一数据系列或所有数据系列，语法如下：

expression.ApplyDataLabels(Type, LegendKey, AutoText, HasLeaderLines, ShowSeriesName, ShowCategoryName, ShowValue, ShowPercentage, ShowBubbleSize, Separator)

• 参数expression是必需的，该表达式返回一个Chart对象。
• 参数Type是可选的，要应用的数据标签的类型，可为表格 60 1所列的XlDataLabelsType 常量之一。

常量	值	描述
xlDataLabelsShowBubbleSizes	6	无
xlDataLabelsShowLabelAndPercent	5	占总数的百分比及数据点所属的分类。仅用于饼图或圆环图。
xlDataLabelsShowPercent	3	占总数的百分比。仅用于饼图或圆环图。
xlDataLabelsShowLabel	4	数据点所属的分类。
xlDataLabelsShowNone	-4142	无数据标签。
xlDataLabelsShowValue	2	数据点的值，若未指定本参数，默认使用此设置。

• 参数LegendKey是可选的，如果该值为True，则显示数据点旁的图例项标示。默认值为False。
• 参数AutoText是可选的，如果对象根据内容自动生成正确的文字，则该值为True。
• 参数HasLeaderLines是可选的，如果数据系列具有引导线，则该值为True。
• 参数ShowSeriesName是可选的，数据标签的系列名称。
• 参数ShowCategoryName是可选的，数据标签的分类名称。
• 参数ShowValue是可选的，数据标签的值。
• 参数ShowPercentage是可选的，数据标签的百分比。
• 参数ShowBubbleSize是可选的，数据标签的气泡尺寸。
• 参数Separator是可选的，数据标签的分隔符。
  第14、15行代码设置新创建的图表有可见的标题并设置图表标题的文字。应用于Chart对象的HasTitle属性，如果坐标轴或图表有可见标题，则该值为True，而ChartTitle属性返回一个ChartTitle对象，代表指定图表的标题。
  第16行到第20行代码设置图表标题文字的格式。
  第21行到第25行代码设置图表区的颜色。
  第26行到第30行代码设置绘图区的颜色。
  第31行代码删除图表上第一个数据系列中的数据标签。SeriesCollection方法返回图表或图表组中单个数据系列（Series对象)或所有数据系列的集合（SeriesCollection集合)的对象，语法如下：

expression.SeriesCollection(Index)

可选的Index参数指定数据系列的名称或编号。
而DataLabels方法则返回代表数据系列中的单个数据标签（DataLabel对象）或所有数据标签的集合（DataLabels集合）的对象，语法如下：

expression.DataLabels(Index)

可选的Index参数指定数据系列中的数据标签的编号。
第32行到第36行代码设置图表上第二个数据系列中的数据标签的字体格式。
运行ChartAdd过程，在工作表中创建簇状柱形图，如图 60 1所示。

图 60 1 创建簇状柱形图

61. 使用独立窗口显示图表

如果需要将工作表中嵌入的图表显示在独立的窗口中，可以使用下面的代码。

Sub ChartShow()With Sheet1.ChartObjects(1).Activate.Chart.ShowWindow = TrueEnd WithWith ActiveWindow.Top = 50.Left = 50.Width = 400.Height = 280.Caption = ThisWorkbook.NameEnd With
End Sub

代码解析：
ChartShow过程，将工作表中嵌入的图表显示在独立的窗口中。
第2行到第5行代码将工作表中指定图表的ShowWindow属性设置为True，使用独立的窗口显示该图表。
第7、8行代码指定活动窗口显示的位置。
第9、10行代码调整活动窗口的大小使之适应图表的大小。
第11行代码指定活动窗口标题栏中显示的标题。
运行ChartShow过程结果如图 61 1所示。

图 61 1 使用独立窗口显示图表

62. 导出工作表中的图表

如果需要将工作表中的图表保存为单独的图像文件，可以使用Export方法以图形文件格式导出图表，示例代码如下。

Sub ExportChart()Dim myChart As ChartDim myFileName As StringSet myChart = Sheet1.ChartObjects(1).ChartmyFileName = "myChart.jpg"On Error Resume NextKill ThisWorkbook.Path & "\" & myFileNamemyChart.Export Filename:=ThisWorkbook.Path _& "\" & myFileName, Filtername:="JPG"MsgBox "图表已保存在[" & ThisWorkbook.Path & "]文件夹中!"Set myChart = Nothing
End Sub

代码解析：
ExportChart过程使用Export方法将工作表中的图表以图形文件的形式导出。
第4行代码指定工作表中的图表对象。
第5行代码指定图形文件保存的文件名。
第6、7行代码使用Kill语句删除文件夹中原有的图形文件。当文件夹中指定删除的文件不存在时Kill语句会出错所以需要使用On Error语句忽略错误。
第8、9行代码使用Export方法将图表导出到同一目录中，应用于Chart对象的Export方法以图形文件格式导出图表，语法如下：

expression.Export(Filename, FilterName, Interactive)

其中参数Filename是必需的，被导出的文件的名称，示例中加上了文件保存的路径。
参数FilterName是可选的，被导出的文件的图形格式，示例中文件以JPG文件格式保存。

63. 多图表制作

如果需要，我们可以为工作表中的每一个数据区域创建一张图表，在如图 63 1所示的工作表区域中，需要为每一个员工的全年数据创建一张图表。

图 63 1 数据区域
示例代码如下：

Sub ChartsAdd()Dim myChart As ChartObjectDim i As IntegerDim R As IntegerDim m As IntegerR = Sheet1.Range("A65536").End(xlUp).Row - 1m = Abs(Int(-(R / 4)))Sheet2.ChartObjects.DeleteFor i = 1 To RSet myChart = Sheet2.ChartObjects.Add _(Left:=(((i - 1) Mod m) + 1) * 350 - 320, _Top:=((i - 1) \ m + 1) * 220 - 210, _Width:=330, Height:=210)With myChart.Chart.ChartType = xlColumnClustered.SetSourceData Source:=Sheet1.Range("B2:M2").Offset(i - 1), _PlotBy:=xlRowsWith .SeriesCollection(1).XValues = Sheet1.Range("B1:M1").Name = Sheet1.Range("A2").Offset(i - 1).ApplyDataLabels AutoText:=True, ShowValue:=True.DataLabels.Font.Size = 10End With.HasLegend = FalseWith .ChartTitle.Left = 5.Top = 1.Font.Size = 14.Font.Name = "华文行楷"End WithWith .PlotArea.Interior.ColorIndex = 2.PatternColorIndex = 1.Pattern = xlSolidEnd With.Axes(xlCategory).TickLabels.Font.Size = 10.Axes(xlValue).TickLabels.Font.Size = 10End WithNextSheet2.SelectSet myChart = Nothing
End Sub

代码解析：
ChartsAdd过程根据数据工作表A列的人数在图表工作表中创建图表并分4行排列整齐。
第6行代码取得数据工作表中需要创建图表的人数。
第7行代码计算图表工作表每行需要排列的图表数目，共分4行排列。使用Int函数返回图表数目除4行后的整数部分，使用负值是为了向上取整数，最后使用Abs函数返回绝对值，将负值转化为正值。
第8行代码使用Delete方法删除图表工作表中存在的所有图表。
第9行代码开始For…Next循环，循环的终值由需要创建的图表数目决定。
第10行到第13行代码使用Add方法在图表工作表中创建嵌入的图表，关于应用于ChartObjects对象的Add方法请参阅技巧60 。其中第11、12行代码根据循环计数器的数值设置新创建图表的Left和Top属性使之依次排列。第13行代码设置图表的大小。
第15行代码设置新创建图表的类型。
第16、17行代码根据循环计数器的数值分别设置新创建图表的数据源。
第18行到第23行代码设置图表第一个数据系列的名称、数据标签和字体格式。
第24行代码删除图表中的图例。
第25行到第30行代码设置图表的标题。
第31行到第35行代码设置图表的绘图区。
第36、37行代码设置图表坐标轴的字体大小。
关于图表的设置请参阅技巧60 。
运行ChartsAdd过程图表工作表中如所示。

图 63 2 图表工作表

第五章 Application对象

64. 取得Excel版本信息

Application对象的Version属性可以返回Excel的版本号，如下面的代码所示。

Sub AppVersion()Dim myVersion As StringSelect Case Application.VersionCase "8.0"myVersion = "97"Case "9.0"myVersion = "2000"Case "10.0"myVersion = "2002"Case "11.0"myVersion = "2003"Case ElsemyVersion = "版本未知"End SelectMsgBox "Excel 版本是： " & myVersion
End Sub

代码解析：
AppVersion过程返回Application对象的Version属性值来取得Excel版本号。
应用于Application对象的Version属性返回Excel版本号，语法如下：

expression.Version

参数expression是必需的，Application对象。
运行AppVersion过程结果如图 64 1所示。

图 64 1 取得Excel版本号

65. 取得当前用户名称

使用Application对象的UserName属性可以取得当前用户名称，如下面的代码所示。

Sub UserName()MsgBox "当前用户名是: " & Application.UserName
End Sub

代码解析：
UserName过程使用消息框显示当前用户名称。
Application对象的UserName属性返回或设置当前用户的名称。
运行UserName过程效果如图 65 1所示。

图 65 1 显示当前用户名称

66. Excel中的“定时器”

Excel VBA并没有提供定时器控件，但是用户可以通过Application对象的OnTime方法实现简单的定时器功能，如下面的代码所示。

Sub StartTimer()Sheet1.Cells(1, 2) = Sheet1.Cells(1, 2) + 1Application.OnTime Now + TimeValue("00:00:01"), "StartTimer"
End Sub

代码解析：
StartTimer过程，使用Application对象的OnTime方法循环调用StartTimer过程实现每隔一秒钟运行一次StartTimer过程，从而在B1单元格中不断地显示程序累计运行时间，如图 66 1所示。

图 66 1 简单的定时器
第2行代码将B1单元格的值在原有的数字上加1。
第3行代码使用OnTime方法在1秒后重新调用StartTimer过程，使B1单元格的值不断的加1，从而显示程序累计运行时间。
应用于Application对象的OnTime方法能够安排一个过程在将来的特定时间运行，语法如下：

expression.OnTime(EarliestTime, Procedure, LatestTime, Schedule)

参数expression是必需的，返回一个Application对象。
参数EarliestTime是必需的，设置指定的过程开始运行的时间。使用Now + TimeValue(time)可以安排从现在开始经过一段时间之后运行某个过程，使用TimeValue(time)可以安排在指定的时间运行某个过程。
参数Procedure是必需的，设置要运行的过程名称。
参数LatestTime是可选的，设置过程开始运行的最晚时间。例如将参数LatestTime设置为EarliestTime+10，当时间到了EarliestTime时如果Excel不处于空闲状态，那么Excel将等待10秒，如果在10秒内Excel不能回到空闲状态，则不运行该过程。如果省略该参数，Excel将一直等待到可以运行该过程为止。
参数Schedule是可选的，如果其值为True（默认值），则安排一个新的OnTime过程，如果其值为False，则清除先前设置的过程。
取消定时的代码如下：

Sub EndTimer()On Error GoTo LineApplication.OnTime Now + TimeValue("00:00:01"), "StartTimer", , FalseSheet1.Cells(1, 2) = 0Exit Sub
Line:MsgBox "请先按[开始]按钮!"
End Sub

代码解析：
EndTimer过程取消StartTimer过程的定时。
第2行代码错误处理语句，因为如果还没有运行StartTimer过程而先运行EndTimer过程取消定时，程序会提示错误，如图 66 2所示，因此使用On Error GoTo Line语句在错误发生时执行第7行代码显示一个如图 66 3所示的提示消息框。

图 66 2 运行错误

图 66 3 提示消息框
第3行代码将StartTimer过程的Schedule参数设置为False，取消定时设置。

67. 设置活动打印机的名称

使用Application 对象的ActivePrinter属性可以设置活动打印机的名称，如下面的代码所示。

Sub myPrinter()Dim myPrinter As StringmyPrinter = "HP LaserJet P1008 在 Ne04:"Application.ActivePrinter = myPrinterMsgBox "活动打印机为：" & Left(myPrinter, InStr(myPrinter, "在") - 1)
End Sub

代码解析：
myPrinter过程将活动打印机设置为“HP LaserJet P1008”。
第3行代码指定需要设置为活动打印机的名称，第4行代码通过设置Application 对象的ActivePrinter属性将活动打印机设置为“HP LaserJet P1008”。
第5行代码使用消息框显示活动打印机的名称及型号。
运行myPrinter过程结果如图 67 1所示。

图 67 1 设置活动打印机

68. 屏蔽、改变组合键的功能

使用Application 对象的OnKey方法可以屏蔽或改变组合键的默认操作，如下面的代码所示。

Private Sub Workbook_Open()Application.OnKey "^{c}", "myOnKey"
End Sub
Sub myOnKey()MsgBox "本工作表禁止复制数据!"
End Sub

代码解析：
第1行到第3行代码工作簿的Open事件，在工作簿打开时使用OnKey方法改变<Ctrl +C>组合键的功能。
应用于Application 对象的OnKey方法指定特定键或特定的组合键运行的过程，语法如下：

expression.OnKey(Key, Procedure)

参数expression是必需的，该表达式返回一个Application 对象。
参数Key是必需的，用于表示要按的键的字符串，具体请参阅VBA中的帮助。
参数Procedure是可选的，表示要运行的过程名称的字符串，本示例中将过程名称指定为第4行到第6行代码的“myOnKey”过程，当按下<Ctrl +C>组合键时并不会执行复制操作而只显示一个消息框。如果将Procedure参数指定为空文本（“”），则按<Ctrl +C>组合键时不发生任何操作，达到屏蔽组合键的效果。
如果省略Procedure参数，则按下<Ctrl +C>组合键时产生Microsoft Excel中的正常结果，同时清除先前使用OnKey方法所做的特殊击键设置，所以恢复<Ctrl +C>组合键的代码如下：

Application.OnKey "^{c}"

为了不影响其他工作簿的功能，恢复代码就放在工作簿的Deactivate事件中，如下面的代码所示：

Private Sub Workbook_Deactivate()Application.OnKey "^{c}"
End Sub

代码解析：
当工作簿从活动状态转为非活动状态时恢复<Ctrl +C>组合键的正常功能。

69. 设置Excel窗口标题栏

Excel主窗口标题栏默认的名称是“Microsoft Excel”，通过设置Application对象的Caption属性可以改变Excel主窗口的标题栏，如下面的代码所示。

Sub AppCaption()Application.Caption = "修改标题栏名称"MsgBox "下面将恢复默认的标题栏名称!"Application.Caption = Empty
End Sub

代码解析：
第2行代码将Excel窗口标题设置为“修改标题栏名称”，如图 69 1所示。

图 69 1 设置Excel窗口标题
应用于Application对象的Caption属性设置显示在Microsoft Excel主窗口标题栏中的名称，语法如下：

expression.Caption

第3行代码恢复Microsoft Excel主窗口标题栏中的名称。如果未设置Caption属性（“”）或将其设置为Empty（表示未初始化的变量值），则本属性返回默认的“Microsoft Excel”。
将Caption属性设置为常数vbNullChar（表示值为 0 的字符）可以删除标题栏中的名称，如下面的代码所示。

Sub DleCaption()Application.Caption = vbNullCharMsgBox "下面将恢复默认的标题栏名称!"Application.Caption =Empty
End Sub

代码解析：
第2行代码删除Excel主窗口标题栏，结果如图 69 2所示。

图 69 2 删除Excel窗口标题栏的名称

70. 自定义Excel状态栏

Excel状态栏显示应用程序的当前状态（例如就绪、输入等）或上下文提示信息，通过设置Application对象的Statusbar属性可以修改状态栏，以显示用户自定义的信息，代码如下：

Sub myStatusBar()Dim rng As RangeFor Each rng In Sheet1.Range("A1:D10000")Application.StatusBar = "正在计算单元格 " & rng.Address(0, 0) & " 的数据..."rng = 100NextApplication.StatusBar = False
End Sub

代码解析：
myStatusBar过程在给选定单元格区域赋值的同时，将Excel状态栏中的文字设置为正在赋值的单元格地址。
应用于Application对象的StatusBar属性返回或设置状态栏中的文字，如果需要恢复默认的状态栏文字，将本属性设为False即可。
运行myStatusBar过程Excel状态栏如图 70 1所示。

图 70 1 自定义Excel状态栏

71. 灵活退出Excel

在使用Close方法关闭工作簿时，既使当前只有一个打开的工作簿，也只能关闭工作簿而不能关闭Excel程序，而使用Application对象的Quit方法则会关闭所有打开的工作簿，下面的代码可以做到两者兼顾。

Sub myQuit()If Workbooks.Count > 1 ThenThisWorkbook.CloseElseApplication.QuitEnd If
End Sub

代码解析：
myQuit过程在关闭Excel程序时根据当前打开的工作簿数量决定采用何种方法关闭工作簿。
第2行代码使用Workbook集合的Count属性判断当前打开的工作簿文件数量。
第3行代码如当前打开两个或两个以上工作簿，使用Close方法关闭代码所在的工作簿。关于Close方法请参阅技巧45-1。
第5行代码如果当前只有一个打开的工作簿文件则使用Quit方法关闭Excel程序。应用于Application对象的Quit方法退出Excel程序，语法如下：

expression.Quit

参数expression是必需的，返回一个Application对象。
使用Quit方法关闭Excel程序时，如果有未保存的工作簿处于打开状态，则将弹出一个询问是否要保存所作更改的对话框，为避免对话框出现，可在使用Quit方法前保存所有的工作簿，或者将Application对象的DisplayAlerts属性设置为False，在退出Excel程序时，即使有未保存的工作簿，也不会显示对话框，而且不保存就退出。
如果一个工作簿的Saved属性值为True，但是并没有将工作簿保存到磁盘上，则Excel程序在退出时不会提示保存该工作簿。

72. 隐藏Excel主窗口

如果希望在程序启动时或运行过程中隐藏Excel主窗口，有以下几种实现方法。
72-1 设置Application对象的Visible属性
当Application对象的Visible属性设置为False时，Application对象不可见，即能隐藏Excel主窗口，如下面的代码所示。

Private Sub Workbook_Open()Application.Visible = FalseUserForm1.Show
End Sub

代码解析：
代码工作簿的Open事件，在工作簿打开时将Application对象的Visible属性设置为False隐藏Excel主窗口。
显示Excel主窗口的方法是将Application对象的Visible属性重新设置为True。
当工作簿文件打开时，隐藏Excel主窗口，只显示用户登录窗体，如图 72 1所示。

图 72 1 隐藏Excel主窗口
72-2 将窗口移出屏幕
设置Application对象的Left属性（从屏幕左边界至Microsoft Excel主窗口左边界的距离）和/或Top属性（从屏幕顶端到Microsoft Excel主窗口顶端的距离）将Application对象移出屏幕外，实现隐藏Excel主窗口，如下面的代码所示。

Private Sub Workbook_Open()Application.WindowState = xlNormalApplication.Left = 10000UserForm1.StartUpPosition = 2UserForm1.Show
End Sub

代码解析：
工作簿的Open事件过程，设置Application对象的Left属性为一个大的数值，从而将应用程序窗口移出屏幕。
第2行代码将应用程序窗口设置为正常状态，只有当应用程序窗口正常显示时才能够设置Application对象的Left属性。
第2行代码将Application对象的Left属性设置为一个大的数值，从而隐藏Excel主窗口。
第4行代码设置用户窗体的StartUpPosition属性值为2，使窗体显示在屏幕的中央。StartUpPosition属性返回或设置一个值，用来指定用户窗体第一次出现时的位置，请参阅技巧142 。
重新显示Excel主窗口的方法是将应用程序窗口设置为最大化状态代码如下：
Application.WindowState = xlMaximized
当工作簿文件打开时，隐藏Excel主窗口，只显示用户登录窗体，如图 72 2所示，与通过设置Visible属性实现的效果不同，设置Left属性在任务栏中仍然会显示应用程序窗口按钮。

图 72 2 隐藏Excel主窗口
72-3 设置工作簿作为加载宏运行
利用加载宏不显示工作簿窗口的特点，设置工作簿作为加载宏运行来隐藏工作簿窗口，如下面的代码所示。

Private Sub Workbook_Open()ThisWorkbook.IsAddin = TrueUserForm1.Show
End Sub

代码解析：
工作簿的Open事件，在工作簿打开时设置其IsAddin属性值为True，指定工作簿作为加载宏运行。
当工作簿作为加载宏运行时，将有工作薄窗口不可见的特征，从而实现隐藏工作簿窗口的目的，如图 72 3所示。

图 72 3 隐藏工作簿窗口
重新显示Excel主窗口的方法是将工作簿的IsAddin属性值设置为False，以显示工作簿窗口。

第六章 使用对话框

73. 使用Msgbox函数

73.1 显示简单的提示信息

在使用Excel的过程中，如果需要向用户显示简单的提示信息，可以使用MsgBox函数显示一个消息框，如下面的代码所示。

  Sub mymsgbox()MsgBox "欢迎光临Excel Home!"
End Sub

代码解析：
Mymsgbox 过程使用MsgBox 函数显示一个消息框。MsgBox 函数用于显示提示信息，语法如下：

MsgBox(prompt[, buttons] [, title] [, helpfile, context])

• 参数prompt：必需的，代表在消息框中作为信息显示的字符或字符串，最多只能接受约1024个字符，取决于所使用字符的宽度。
• 参数buttons：可选的，用于指定消息框中显示按钮的数目及类型、使用的图标样式、缺省按钮以及消息框的强制回应等。如果省略，则buttons参数的缺省值为0，消息框只显示“确定”按钮。
• 参数title：可选的，代表在消息框标题栏中作为标题的字符或字符串。如果省略，则在标题栏中显示“Microsoft Excel”。
• 参数helpfile 和参数context：可选的，用来为消息框提供上下文相关帮助的帮助文件和帮助主题。如果提供了其中一个参数，则必须提供另一个参数，两者缺一不可。
  运行Mymsgbox过程，显示如图所示的消息框。
  

73.2 定制个性化的消息框

如果希望MsgBox函数显示的消息框具有特定的按钮、图标和标题栏，那么可以使用MsgBox函数的buttons参数和title参数，如下面的代码所示。

Sub Specialmsbox()MsgBox Prompt:="欢迎光临 Excel Home!", _Buttons:=vbOKCancel + vbInformation, _Title:="Excel Home"
End Sub

代码解析：
Specialmsbox过程使用MsgBox函数显示一个具有特定的按钮、图标和标题栏的消息框。
第3行代码设置消息框的Buttons参数，使消息框显示时具有“确定”、“取消”按钮和信息消息图标。MsgBox函数的buttons参数设置值如表格 73 1所示。

参数组	常数	值	描述
vbOKOnly	0	只显示“确定”按钮（默认设置）
VbOKCancel	1	显示“确定”和“取消”按钮
VbAbortRetryIgnore	2	显示“放弃”、“重试”、和“忽略”按钮
VbYesNoCancel	3	显示“是”、“否”和“取消”按钮
VbYesNo	4	显示“是”和“否”按钮
VbRetryCancel	5	显示“重试”和“取消”按钮

第二组设置图标的风格 VbCritical 16 显示危险消息图标
VbQuestion 32 显示警告询问图标
VbExclamation 48 显示警告消息图标
VbInformation 64 显示信息消息图标
第三组设置默认按钮 vbDefaultButton1 0 第一个按钮为默认按钮
vbDefaultButton2 256 第二个按钮为默认按钮
vbDefaultButton3 512 第三个按钮为默认按钮
vbDefaultButton4 768 第四个按钮为默认按钮
第四组设置消息框特征 vbApplicationModal 0 应用程序模式：用户必须对消息框作出响应才能继续使用当前的应用程序
vbSystemModal 4096 系统模式：应用程序都被挂起直至用户对消息框作出响应
第五组附加选项 vbMsgBoxHelpButton 16384 在消息框上添加“帮助”按钮
VbMsgBoxSetForeground 65536 将消息框设置为前景窗口
vbMsgBoxRight 524288 显示右对齐的消息框
vbMsgBoxRtlReading 1048576 指定在希伯来和阿拉伯语系统中显示的文本应当从右到左阅读
表格 73 1 MsgBox函数的buttons参数值
在设定buttons参数值时，这些值可以相加使用，但每一组中只能选择一个值。在程序代码中也可以使用buttons参数的常数名称，而不必使用实际数值。
第4行代码将消息框的Title参数设置为“Excel Home”，使消息框的标题栏显示“Excel Home”。
运行Specialmsbox过程后，显示一个如图 73 2所示的消息框，该消息框具有“Excel Home”标题、信息消息图标和“确定”、“取消”按钮并以“确定”按钮作为默认按钮。

图 73 2 具有特定按钮、图标和标题栏的消息框

73.3 获得消息框的返回值

如果希望能根据用户对于消息框的不同选择，进行相应的操作，可以对消息框的返回值进行判断，如下面的代码所示。

Private Sub Workbook_BeforeClose(Cancel As Boolean)Dim iMsg As IntegeriMsg = MsgBox("文件即将关闭,是否保存?", 3 + 32)Select Case iMsgCase 6Me.SaveCase 7Me.Saved = TrueCase 2Cancel = TrueEnd Select
End Sub

代码解析：
工作簿的BeforeClose过程，在关闭工作簿前使用MsgBox函数显示一个消息框，并根据用户的回应用进行相应的操作。
第3行代码，使用MsgBox函数显示一个具有“是”、“否”和“否”按钮的消息框，并把用户的回应，即消息框的返回值赋给变量iMsg。MsgBox是一个函数，这意味着它将返回一个值，如果希望获得返回值，可使用和第3行相似的代码，此时如果不使用括号将参数封闭起来，则会提示编译错误，如图 73 3所示。

图 73 3 提示编译错误
第4行到第11行代码，Select Case结构语句，根据变量iMsg的值判断用户的回应，如果变量iMsg的值为6，说明用户选择了“是”按钮，则使用Save方法保存工作簿；如果变量iMsg的值为7，说明用户选择了“否”按钮，则将工作簿的Saved属性设置为True，不保存更改而直接关闭工作簿。关于Save方法和Saved属性请参阅技巧45-2。如果变量iMsg的值为2，说明用户选择了“取消”按钮，是将BeforeClose过程的Cancel 参数设置为True，取消关闭工作簿操作。
MsgBox函数的返回值如表格 73 2所示，在程序代码中也可以使用常数名称，而不必使用实际数值。

常量	值	描述
vbOK	1	确定
vbCancel	2	取消
vbAbort	3	放弃
vbRetry	4	重试
vbIgnore	5	忽略
vbYes	6	是
vbNo	7	否

表格 73 2 MsgBox函数的返回值
在关闭本工作簿时将显示一个如图 73 4所示的消息框，询问用户是否保存，并根据用户的回应用进行相应的操作。

图 73 4 询问消息框

73.4 在消息框中排版

如果在消息框中显示的字符串很长，比如是一段多行的文字内容，为了达到美观的效果，需要首字缩进，并将各行分隔开来，如下面代码所示。

Sub Newlinemsbox()MsgBox Space(4) & "欢迎来到 ExcelHome 技术论坛，全球最领先的 Excel 技术论坛之一。" & Chr(10) _& Space(4) & "在这里，我们讨论 Microsoft  Office 系列产品的应用技术，重点讨论" & Chr(10) _& "Microsoft Excel。" & Chr(10) _& Space(4) & "本论坛从属于 Excel Home 这一全球最大的华语 Excel 技术门户，目前" & Chr(10) _& "是个人、非营利性质的网站学习平台。" & Chr(10) _& Space(4) & "Let’s do it better! 这是 Excel Home 的口号，我们的宗旨是帮助大" & Chr(10) _& "家解决在使用Office软件中的问题，提升自己的应用技能。"
End Sub

代码解析：
Newlinemsbox 过程使用消息框显示一段经过排版后的文本内容。
代码中使用Space 函数在每段的首字前插入4个空格，使首字缩进，在需要换行的地方插入换行符 （Chr(10)） 将各行分隔开来。也可以使用回车符 （Chr(13)）、或是回车与换行符的组合 （Chr(13) & Chr（10)）换行。
在程序代码中也可以使用vbCrLf、vbNewLine等常数，而不必使用Chr 函数，如表格 73 3所示。
常数 等于 描述
vbCrLf Chr(13) + Chr(10) 回车符与换行符结合
vbCr Chr(13) 回车符
vbLf Chr(10) 换行符
vbNewLine Chr(13) + Chr(10) or, on the Macintosh, Chr(13) 平台指定的新行字符
表格 73 3 回车符与换行符
运行Newlinemsbox过程, 用消息框显示一段经过排版后的文本内容,效果如图 73 5所示。

图 73 5 在消息框中排版

73.5 对齐消息框中显示的信息

在用消息框显示如图 73 6所示的工作表中多行多列的单元格区域时，如果只用换行符（Chr(10)）等进行换行，而数据列没有对齐，会使显示的信息显得杂乱无章，缺乏可读性，如图 73 7所示。

图 73 6 工作表单元格区域

图 73 7 没有对列进行分隔的消息框
为了达到消息框中显示信息各列对齐的效果，在使用换行符（Chr(10)）等进行换行的基础上，还需要使用制表符（Chr(9)）或常数 vbTab，对数据列进行分隔，使之排列整齐，如下面代码所示。

Sub Outmsbox()Dim sMsg As StringDim iRow As IntegerDim iCom As IntegerFor iRow = 1 To 11For iCom = 1 To 5'iCom循环中在把逐列读取的单元格内容赋给变量myMsg时插入一个制表符（Chr(9)），对列进行分隔。sMsg = sMsg & Cells(iRow, iCom) & Chr(9)Next'iRow循环中在读取下一行单元格内容赋给变量myMsg时插入一个换行符（Chr(10)），对行进行换行。sMsg = sMsg & Chr(10)NextMsgBox sMsg
End Sub

代码解析：
Outmsbox过程使用两层循环读取当前工作表中A1到E11单元格的内容，并用消息框显示出来。
运行Outmsbox过程将用消息框显示当前工作表中A1至E11单元格区域中的内容，并排列整齐，如图所示。

74. 自动关闭的消息框

在程序执行完毕后给用户一个提示信息，但用MsgBox函数显示的消息框将一直保持，需要用户单击“确定”或“关闭”按钮才会关闭。如果希望显示的消息框自动关闭，那么可以使用以下方法显示消息框。

74.1 使用WshShell.Popup方法显示消息框

Sub WshShell()Dim WshShell As ObjectSet WshShell = CreateObject("Wscript.Shell")WshShell.popup "执行完毕!", 2, "提示", 64Set WshShell = Nothing
End Sub

代码解析：
WshShell 过程使用WshShell.Popup方法显示消息框，2秒后自动关闭。
WshShell.Popup方法的语法如下：

WshShell.Popup(strText, [natSecondsToWait], [strTitle], [natType]) = intButton

• 参数strText：必需的，与 Msgbox 的 Prompt 参数类似，代表在消息框中作为信息显示的字符或字符串。如果显示的内容超过一行，可以在每一行之间用换行符 （Chr(10)）等将各行分隔开来。
• 参数natSecondsToWait：可选的，其时间单位为妙。如果提供natSecondsToWait参数且其值大于零，则消息框在natSecondsToWait 参数指定的秒数后关闭。
• 参数strTitle：可选的，代表在消息框标题栏中作为标题的字符或字符串，若省略，则窗口标题为“Windows 脚本宿主”。
• 参数natType：可选的，指定消息框中显示按钮的数目及类型、使用的图标样式、缺省按钮以及消息框的强制回应等，与MsgBox函数buttons参数相同。
• 参数intButton：指示用户所单击的按扭编号，与MsgBox函数的返回值相同。若用户在natSecondsToWait 秒之前不单击按扭，则返回值为 -1 。
  运行WshShell过程显示一个如图 所示消息框，无需点击“确定”按纽，2秒后自动关闭。
  

74.2 使用API函数显示消息框

使用API函数也可以达到这一效果，如下面的代码所示。

Public Declare Function SetTimer Lib "user32" ( _ByVal hWnd As Long, _ByVal nIDEvent As Long, _ByVal uElaspe As Long, _ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _ByVal hWnd As Long, _ByVal nIDEvent As Long) As LongDim TID As Long
Sub Test()TID = SetTimer(0, 0, 2000, AddressOf CloseTest)MsgBox "执行完毕!"
End Sub
Sub CloseTest(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idevent As Long, _ByVal Systime As Long)Application.SendKeys "~", TrueKillTimer 0, TID
End Sub

代码解析：
Test过程显示一个消息框并在3秒钟后运行CloseTest过程。
CloseTest过程发送一个确定键给Excel程序关闭显示的消息框。
运行Test过程显示一个消息框并在2秒钟后关闭。

75. 使用InputBox函数

75.1 简单的数据输入

Excel 的使用过程中，有时需要用户输入简单的数据，此时可以使用InputBox 函数显示一个对话框，供用户在对话框中输入数据信息，如下面的代码所示。

Sub myInputBox()Dim sInt As StringDim r As Integerr = Sheet1.Range("A65536").End(xlUp).RowsInt = InputBox("请输入人员姓名：")If Len(Trim(sInt)) > 0 ThenSheet1.Cells(r + 1, 1) = sIntElseMsgBox "您没有输入内容!"End If
End Sub

代码解析：
myInputBox 过程使用InputBox 函数显示一个对话框供用户在对话框中输入数据，InputBox 函数显示一个对话框，等待用户输入正文或按下按钮，并返回包含文本框内容的字符串，语法如下：

InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context])

• 参数prompt：必需的，作为对话框消息出现的字符串表达式。
• 参数title：可选的，作为显示在对话框标题栏中的字符串表达式，如果省略title参数，则在标题栏中显示“Microsoft Excel”。
• 参数default：可选的，显示在文本框中的字符串表达式，在没有其它输入时作为缺省值，如果省略default参数，则文本框为空。
• 参数xpos：可选的，指定对话框的左边与屏幕左边的水平距离。如果省略xpos参数，则对话框会在水平方向居中。
• 参数ypos：可选的，指定对话框的上边与屏幕上边的距离。如果省略ypos参数，则对话框被放置在屏幕垂直方向距下边大约三分之一的位置。
• 参数helpfile和参数context：可选的，为对话框提供上下文相关的帮助和编号，如果提供了其中一个参数，则必须提供另一个参数，两者缺一不可。

第5行代码，使用InputBox函数显示一个提示用户输入邮政编码的对话框，其中“请输入人员姓名：”是必需的prompt参数，其他参数使用缺省值。
第4行代码，使用Len函数和Trim函数判断返回的去除空格后的字符串长度。如果字符串长度大于零，说明用户单击了对话框的“确定”按钮，则将用户输入的数据写到工作表的A列单元格。如果返回的是长度为零的字符串，说明用户单击了对话框的“取消”按钮，则显示一条提示消息。
因为当用户单击对话框的“确定”按钮后，InputBox函数返回包含文本框内容的字符串，如果用户单击对话框的“取消”按钮则返回一个长度为零的字符串（“”），通过返回的字符串长度可以判断用户做出的选择。
运行sInput 过程将显示一个提示用户输入数据的对话框，如图所示。

75.2 使用对话框输入密码

使用InputBox函数显示的对话框输入密码简单方便，但有个明显的缺陷，就是输入过程中不能用占位符显示密码，不够安全。借助API函数可以在输入密码过程中以占位符“*”号来显示密码，如下面的代码所示。

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public Const EM_SETPASSWORDCHAR = &HCC
Public lTimeID As Long
Sub TimeProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)Dim hwd As Longhwd = FindWindow("#32770", "密码")If hwd <> 0 Thenhwd = FindWindowEx(hwd, 0, "edit", vbNullString)SendMessage hwd, EM_SETPASSWORDCHAR, 42, 0timeKillEvent lTimeIDEnd IfEnd Sub
Sub Password()Dim Password As VariantlTimeID = timeSetEvent(10, 0, AddressOf TimeProc, 1, 1)Password = InputBox("请输入密码：", "密码")If Password = "123456" ThenMsgBox "密码正确!"ElseMsgBox "密码错误!"End If
End Sub

代码解析：
Password过程使用InputBox函数显示一个输入密码的对话框，并且以占位符“”号显示输入的密码。
第1行到第8行代码，API函数声明。
第9行到第17行代码，TimeProc过程是timeSetEvent的回调函数，获得对话框句柄。
第18行到第27行代码，Password过程显示一个提示用户输入密码的对话框。
运行Password过程将显示一个密码输入框，输入的密码以占位符“”号代替，如图 所示。

76. 使用InputBox方法

在Excel 中输入简单的数据可以使用InputBox 函数显示的对话框，但是如果输入的数据类型不匹配时，过程运行时会产生意外错误。为了避免此类情况发生，可以使用另一种获得用户输入的方式——InputBox 方法。

76.1 输入指定类型的数据

使用InputBox方法输入数据时可以指定数据的类型，如下面的代码所示。

Sub dInput()Dim dInput As DoubleDim r As Integerr = Sheet1.Range("A65536").End(xlUp).RowdInput = Application.InputBox(Prompt:="请输入数字：", Type:=1)If dInput <> False ThenSheet1.Cells(r + 1, 1).Value = dInputElseMsgBox "你已取消了输入!"End If
End Sub

代码解析：
dInput过程使用InputBox方法显示一个提示用户输入数字的对话框。
InputBox方法显示一个接收用户输入的对话框，返回此对话框中输入的信息，语法如下：

expression.InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextId, Type)

• 参数expression：必需的，返回一个Application对象。
• 参数Prompt：必需的，作为对话框消息显示的字符串表达式。
• 参数Title：可选的，作为显示在对话框标题栏中的字符串表达式。如果省略Title参数，将使用默认的标题。
• 参数Default：可选的，在对话框显示时出现在文本框中的初始值。如果省略Default参数，则文本框为空。
• 参数Left：可选的，指定对话框相对于屏幕左上角的 x 坐标。
• 参数Top：可选的，指定对话框相对于屏幕左上角的 y 坐标。
• 参数HelpFile和参数HelpContextId：可选的，为对话框提供上下文相关的帮助和编号，如果提供了其中一个参数，则必须提供另一个参数，两者缺一不可。
• 参数Type：可选的，指定返回的数据类型。如果省略Type参数，对话框将返回文本。
  InputBox方法的语法和InputBox函数的语法相似，最大的区别在于最后一个参数——Type。通过Type参数可以指定返回值的数据类型，下表列出了Type参数可以使用的数值。

数值	期望的返回值
0	一个公式
1	一个数字
2	文本（字符串）
4	一个逻辑值，例如true或false
8	一个单元格引用
16	一个错误值
64	一个值的数组

这些数值可以相加使用，如果希望返回数字和文本，可以将Type参数设置为1+2。
InputBox方法与InputBox函数相比，优点是内置的出错处理。
在第5行代码中将Type参数值设置为1，这意味着对话框只能输入数值。当用户输入的不是数值时，显示一个如图所示的消息框提示输入错误。

第6行到第10行代码，如果用户单击对话框的“确定”按钮，将用户输入的数字写入工作表的A列单元格。如果用户单击对话框的“取消”按钮，则显示一条提示消息。
InputBox方法和InputBox函数的另一个区别是，当用户单击“取消”按纽时返回False而不是长度为零的字符串。
运行dInput过程将显示一个提示用户输入数字的对话框，如图所示。

注意：在VBA代码中，Application.InputBox 调用的是InputBox 方法，不带对象识别符的InputBox 调用的是InputBox 函数。

76.2 获得单元格区域地址

InputBox 方法很适合用户选择工作表单元格区域，并对所选择的单元格区域进行操作，如下面的代码所示。

Sub RngInput()Dim rng As RangeOn Error GoTo lineSet rng = Application.InputBox("请使用鼠标选择单元格区域：", , , , , , , 8)rng.Interior.ColorIndex = 15
line:
End Sub

代码解析：
RngInput 过程使用InputBox 方法显示一个对话框，提示用户在工作表中选择一个单元格区域，并改变所选单元格区域内部的颜色。
第3行代码，错误处理语句。因为当对话框显示后，如果用户单击“取消”按钮，将显示一错误信息，所以必需使用On Error GoTo语句来绕过错误。

第4行代码，使用Set语句将用户选择的单元格区域赋给变量rng。当Type参数设置为8时，将返回一个Range对象，必须用Set 语句将结果指定给一个Range对象。
第5行代码，改变用户所选单元格区域内部的颜色。
运行RngInput过程，将显示一个对话框，提示用户在工作表中选择一个单元格区域，并改变所选单元格区域内部的颜色，如图所示。

77. 内置对话框

77.1 调用内置的对话框

如果需要使用“打开”、“打印”等Excel内置对话框已经具有的功能，可以使用代码直接调用这些内置的对话框，如下面的代码所示。

Sub DialogOpen()Application.Dialogs(xlDialogOpen).Show arg1:=ThisWorkbook.Path & "\*.xls"
End Sub

代码解析：
DialogOpen过程显示内置的“打开”对话框并选定示例所在的文件夹。
显示内置对话框语法如下：

Application.Dialogs(xlDialogConst).Show

Dialogs集合代表所有的内置对话框，每个Dialog对象代表一个内置对话框，不能新建内置对话框或向该集合中添加内置对话框。
参数xlDialogConst是内置对话框的内置常量，每个常量都以“xlDialog”开头，其后是对话框的名称，如“打开”对话框的常量为“xlDialogOpen”。常用内置对话框的内置常量如表格 77 1所示。

常量	值	说明
xlDialogActiveCellFont	476	单元格格式(字体）
xlDialogBorder	45	单元格格式(边框）
xlDialogCellProtection	46	单元格格式(保护）
xlDialogDeleteFormat	111	单元格格式(数字）
xlDialogFormatNumber	42	单元格格式(数字）
xlDialogPatterns	84	单元格格式(图案）
xlDialogClear	52	清除
xlDialogColumnWidth	47	列宽
xlDialogRowHeight	127	行高
xlDialogConditionalFormatting	583	条件格式
xlDialogDefineName	61	定义名称
xlDialogDefineStyle	229	样式
xlDialogDisplay	27	显示选项
xlDialogFont	26	字体
xlDialogSetBackgroundPicture	509	工作表背景
xlDialogInsert	55	插入
xlDialogInsertHyperlink	596	插入超链接
xlDialogInsertPicture	342	插入图片
xlDialogNew	119	新建工作簿
xlDialogOpen	1	打开
xlDialogSaveAs	5	另存为
xlDialogWorkbookCopy	283	移动或复制工作表（建立副本）
xlDialogWorkbookInsert	354	插入工作表
xlDialogWorkbookMove	282	移动或复制工作表
xlDialogWorkbookName	386	重命名工作表
xlDialogWorkbookNew	302	新建工作表
xlDialogWorkbookProtect	417	保护工作簿
xlDialogPageSetup	7	页面设置
xlDialogPrint	8	打印内容
xlDialogPrinterSetup	9	打印机设置
xlDialogPrintPreview	222	打印预览
xlDialogSetPrintTitles	23	设置打印标题
xlDialogRun	17	宏
xlDialogTable	41	模拟运算表
xlDialogSendMail	189	发送邮件

表格 77 1 内置对话框的内置常量
显示内置对话框使用Show方法，应用于Dialog对象的Show方法语法如下：

expression.Show(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30)

参数expression是必需的，返回Dialog对象之一。
参数arg1到参数arg30是可选的，仅应用于内置对话框，是命令的初始参数。若要查找要设置的参数，请在内置对话框参数列表中查找对应的对话框常量。
运行alogOpen过程，显示内置的“打开”对话框，并且直接选定示例所在的文件夹，如图 77 1所示。

图 77 1 使用内置对话框

77.2 获取选定文件的文件名

如果只希望获取用户在显示的内置 “打开”对话框中选定文件的文件名，而不想真正打开该文件，那么可以使用GetOpenFilename方法，如下面的代码所示。

Sub OpenFilename()Dim Filename As VariantDim mymsg As IntegerDim i As IntegerFilename = Application.GetOpenFilename(Title:="删除文件", MultiSelect:=True)If IsArray(Filename) Thenmymsg = MsgBox("是否删除所选文件?", vbYesNo, "提示")If mymsg = vbYes ThenFor i = 1 To UBound(Filename)Kill Filename(i)NextEnd IfEnd If
End Sub

代码解析：
OpenFilename过程使用GetOpenFilename方法显示标准的内置“打开”对话框，获取用户选定文件的文件名后使用Kill语句删除。
GetOpenFilename方法显示标准的内置“打开”对话框，获取文件名，语法如下：

expression.GetOpenFilename(FileFilter, FilterIndex, Title, ButtonText, MultiSelect)

• 参数expression：必需的，返回一个Application对象。
• 参数FileFilter：可选的，指定文件筛选条件的字符串。如果省略，则默认参数值为“所有文件(.)”。
• 参数FilterIndex：可选的，指定默认文件筛选条件的索引号，取值范围为 1 到由 FileFilter 所指定的筛选条件数目。如果省略，或者取值大于可用筛选数目，则采用第一个文件筛选条件。
• 参数Title：可选的，指定对话框的标题。如果省略，则使用“打开”作为标题。
• 参数ButtonText：可选的，仅用于Macintosh。
• 参数MultiSelect：可选的，如果该值为True，则允许选定多个文件名，如果该值为False，则只允许选定单个文件名。默认值为False。

第5行代码显示标准的“打开”对话框，将对话框的标题设置为“删除文件”，将MultiSelect参数设置为True，允许选定多个文件。
第6行代码，获得返回值。当用户选定文件后，返回的是选定的文件名或用户输入的文件名。因为MultiSelect参数已设置为True，所以返回值将是一个包含所有选定文件名的数组（即使仅选定了一个文件名）。如果用户取消了对话框，则该值为False。
第8行到第12行代码，经询问用户后使用Kill语句从磁盘中删除用户选定的文件。
运行OpenFilename过程，显示标准的内置“打开”对话框，删除用户选定的文件，如所图 77 2示。

图 77 2 获取用户选定文件的文件名
注意：VBA中数组下界默认从0开始，但使用GetOpenFilename方法选择多个文件时返回的包含选定文件名的数组下界是从1开始。

77.3 使用“另存为”对话框

在备份文件时可以使用GetSaveAsFilename方法显示标准的内置“另存为”对话框，获取备份文件的文件名和保存路径，而无须真正保存任何文件。如下面的代码所示。

Sub CopyFilename()Dim NowWorkbook As WorkbookDim FileName As StringOn Error GoTo lineFileName = Application.GetSaveAsFilename _(InitialFileName:="D:\" & Date & " " & ThisWorkbook.Name, _fileFilter:="Excel files(*.xls),*.xls,All files (*.*),*.*", _Title:="数据备份")If FileName <> "False" ThenSet NowWorkbook = Workbooks.AddWith NowWorkbook.SaveAs FileNameThisWorkbook.Sheets("Sheet2").UsedRange.Copy _.Sheets("Sheet1").Range ("A1").SaveEnd WithGoTo lineEnd IfExit Sub
line:ActiveWorkbook.Close
End Sub

代码解析：
CopyFilename过程使用GetSaveAsFilename方法显示标准的内置“另存为”对话框，获取备份文件的文件名和保存路径，新建工作簿保存备份数据。
第4行代码，错误处理语句。备份过程中，如果已存在同名工作簿，会出现如图 77 3所示的提示，如果选择了“否”，此时新工作簿已经建立，在执行第12行代码时发生错误，使程序中断，所以使用GoTo语句执行第21行代码，关闭新建立的工作簿。

图 77 3 文件已存在提示
第5行代码，使用GetSaveAsFilename方法显示标准的内置“另存为”对话框。GetSaveAsFilename方法的语法如下：

expression.GetSaveAsFilename(InitialFilename, FileFilter, FilterIndex, Title, ButtonText)

• 参数expression：必需的，返回一个Application对象。
• 参数InitialFilename：可选的，指定建议的文件名。如果省略，将活动工作簿的名称作为建议的文件名。
• 参数FileFilter：可选的，指定文件筛选条件的字符串。
• 参数FilterIndex：可选的，指定默认文件筛选条件的索引号，取值范围为 1 到 FileFilter 指定的筛选条件数目之间。如果省略，或者取值大于可用筛选数目，则采用第一个文件筛选条件。
• 参数Title：可选的，指定对话框标题。如果省略，则使用默认标题。
• 参数ButtonText：可选的，仅用于 Macintosh。
  第6行代码，设置对话框的保存路径为D盘，保存文件名为日期加工作簿名称。
  第7行代码，设置对话框文件保存类型为Excel文件类型。如果需要设置为文本类型需设置为“文本文件(.txt), .txt”，而如果是图片文件则需设置为“图片文件(.bmp;.jpg),* bmp;*.jpg”。
  第8行代码，设置对话框的标题为“数据备份”。
  第9行代码，如果用户没有取消操作。
  第10行到第16行代码，使用Add方法新建工作簿保存到对话框选定的路径中，将数据备份到新工作簿中。
  第17行代码，使用GoTo语句执行第21行代码，关闭新建工作簿和开启屏幕刷新。
  运行CopyFilename过程，显示内置“另存为”对话框，供用户备份工作簿数据，如图 77 4所示。

图 77 4 使用“另存为”对话框备份文件

78. 调用操作系统“关于”对话框

VBA程序开发完成后，有时需要一个“关于”对话框，除了使用窗体外，还可以调用操作系统的“关于”对话框，显示自定义的内容，如下面的代码所示。

Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" ( _ByVal hwnd As Long, ByVal szApp As String, _ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Sub CommandButton1_Click()Dim ApphWnd As LongApphWnd = FindWindow("XLMAIN", Application.Caption)ShellAbout ApphWnd, "财务处理系统", "yuanzhuping@yeah.net  0513-86548930", 0
End Sub

代码解析：
第1行到第5行代码是API函数声明。
第8、9行代码调用操作系统的“关于”对话框并显示自定义的内容。
代码运行后显示如图 78 1所示的对话框。

图 78 1 调用操作系统的“关于”对话框

第七章 菜单和工具栏

79. 在菜单中添加菜单项

在Excel工作表的菜单中可以添加新的菜单项和子菜单，如下面的代码所示。

Sub myTools()Dim myTools As CommandBarPopupDim myCap As VariantDim myid As VariantDim i As BytemyCap = Array("基础应用", "VBA程序开发", "函数与公式", "图表与图形", "数据透视表")myid = Array(281, 283, 285, 287, 292)With Application.CommandBars("Worksheet menu bar").ResetSet myTools = .Controls("帮助(&H)").Controls.Add(Type:=msoControlPopup, Before:=1)With myTools.Caption = "Excel Home 技术论坛".BeginGroup = TrueFor i = 1 To 5With .Controls.Add(Type:=msoControlButton).Caption = myCap(i - 1).FaceId = myid(i - 1).OnAction = "myC"End WithNextEnd WithEnd WithSet myTools = Nothing
End Sub

代码解析：
myTools过程使用Add方法在Excel工作表菜单栏中的“帮助”菜单中添加一个标题为“Excel Home 技术论坛”的菜单项和5个子菜单。
第2行到第5行代码声明变量类型。
第6、7行代码使用Array函数创建两个数组用于保存子菜单的名称和图标ID。
第9行代码，在添加菜单项前先使用Reset方法重置菜单栏以免重复添加菜单项。Reset方法重置一个内置控件，恢复该控件原来对应的动作，并将各属性恢复成初始状态，语法如下：

expression.Reset

参数expression 是必需的，返回一个命令栏或命令栏控件对象。
第10行代码，使用Add方法在Excel工作表菜单栏中的“帮助”菜单中添加菜单项。Add方法应用于CommandBarControls对象时，新建一个CommandBarControl对象并添加到指定命令栏上的控件集合，语法如下：

expression.Add(Type, Id, Parameter, Before, Temporary)

参数expression 是必需的，返回一个CommandBarControls对象，代表命令栏中的所有控件。
参数Type是可选的，添加到指定命令栏的控件类型，可以为表格 79 1所列的MsoControlType常数之一。
常数 值 控件类型
msoControlButton 1 命令按钮
msoControlEdit 2 文本框
msoControlDropdown 3 下拉列表控制框
msoControlComboBox 4 下拉组合控制框
msoControlPopup 10 弹出式控件
表格 79 1 MsoControlType常数
因为在本例中将添加的是带有子菜单的菜单项，所以将参数Type设置为弹出式控件。
参数Id是可选的，标识整数。如果将该参数设置为 1或者忽略，将在命令栏中添加一个空的指定类型的自定义控件。
参数Parameter是可选的，对于内置控件，该参数用于容器应用程序运行命令。对于自定义控件，可以使用该参数向Visual Basic过程传递信息，或用其存储控件信息。
参数Before是可选的，表示新控件在命令栏上位置的数字。新控件将插入到该位置控件之前。如果忽略该参数，控件将添加到指定命令栏的末端。本例中将Before参数设置为1，菜单项添加到“帮助”菜单的顶端。
参数Temporary是可选的。设置为True将使添加的菜单项为临时的，在关闭应用程序时删除。默认值为False。
第12行代码，设定新添加菜单项的Caption属性为“Excel Home 技术论坛”。Caption属性返回或设置命令栏控件的标题。
第13行代码，设置新添加菜单项的BeginGroup属性为True，分组显示。
第14行到第19行代码，在“Excel Home 技术论坛”菜单项上添加五个子菜单并设置其Caption属性、FaceId属性和OnAction属性。
FaceId属性设置出现在菜单标题左侧的图标，以数字表示，一个数字代表一个内置的图标。
OnAction属性设置一个VBA的过程名，该过程在用户单击子菜单时运行，本例中设置为下面的过程。

Public Sub myC()MsgBox "您选择了： " & Application.CommandBars.ActionControl.Caption
End Sub

代码解析：
myC过程是单击新添加子菜单所运行过程，为了演示方便在这里只使用MsgBox函数显示所其Caption属性。
删除新添加的菜单项及子菜单的代码如下所示。

Sub DelmyTools()Application.CommandBars("Worksheet menu bar").Reset
End Sub

代码解析：
DelmyTools过程使用Reset方法重置菜单栏，删除添加的菜单项及子菜单。
为了在打开工作簿时自动添加菜单项，需要在工作簿的Activate事件中调用myTools过程，如下面的代码所示。

 Private Sub Workbook_Activate()Call myToolsEnd Sub

为了在关闭工作簿时删除新添加的菜单项，还需要在工作簿的Deactivate事件中调用DelmyTools过程，如下面的代码所示。

Private Sub Workbook_Deactivate()Call DelmyTools
End Sub

如果希望这个菜单为所有工作簿使用，那么就应该在工作簿的Open事件中调用myTools过程，在BeforeClose事件中调用DelmyTools过程。
运行myTools过程，将在Excel工作表菜单栏中的“帮助”菜单中添加一个名为“Excel Home 技术论坛”的菜单项及五个子菜单，如图 79 1所示。

图 79 1 在“帮助”菜单中添加菜单项及子菜单

80. 在菜单栏指定位置添加菜单

除了可以在工作表菜单中添加菜单项外，还可以在工作表菜单栏的指定位置添加菜单，如下面的代码所示。

Sub AddNewMenu()Dim HelpMenu As CommandBarControlDim NewMenu As CommandBarPopupWith Application.CommandBars("Worksheet menu bar").ResetSet HelpMenu = .FindControl(ID:=.Controls("帮助(&H)").ID)If HelpMenu Is Nothing ThenSet NewMenu = .Controls.Add(Type:=msoControlPopup)ElseSet NewMenu = .Controls.Add(Type:=msoControlPopup, _Before:=HelpMenu.Index)End IfWith NewMenu.Caption = "统计(&S)"With .Controls.Add(Type:=msoControlButton).Caption = "输入数据(&D)".FaceId = 162.OnAction = ""End WithWith .Controls.Add(Type:=msoControlButton).Caption = "汇总数据(&T)".FaceId = 590.OnAction = ""End WithEnd WithEnd WithSet HelpMenu = NothingSet NewMenu = Nothing
End Sub

代码解析：
AddNewMenu过程使用Add方法在工作表“帮助”菜单前添加一个标题为“统计”的菜单和两个菜单项。
第6行代码，使用FindControl方法在工作表菜单栏中查找“帮助”菜单。应用于CommandBars对象的FindControl方法返回一个符合指定条件的CommandBarControl对象。语法如下：

expression.FindControl(Type, Id, Tag, Visible, Recursive)

参数expression是必需的，返回一个CommandBars对象。
参数Type是可选的，要查找控件的类型。
参数Id是可选的，要查找控件的标识符。
参数Tag是可选的，要查找控件的标记值。
参数Visible是可选，如果该值为True，那么只查找屏幕上显示的命令栏控件。默认值为False。
参数Recursive是可选的，如果该值为True，那么将在命令栏及其全部弹出式子工具栏中查找。此参数仅应用于CommandBar对象。默认值为False。
如果没有控件符合搜索条件，那么FindControl方法返回Nothing。
第7行到第12行代码，如果工作表菜单栏中存在“帮助”菜单，将“统计”菜单添加到“帮助”菜单之前，否则添加到工作表菜单栏末尾。
第12行到第25行代码，在“统计”菜单中添加两个子菜单并设置其各种属性。
运行AddNewMenu过程，将在工作表菜单栏的“帮助”菜单之前添加一个“统计”菜单，如图 80 1所示。

图 80 1 在工作表菜单栏中添加菜单

81. 屏蔽和删除工作表菜单

如果不希望用户使用工作表菜单栏的部分功能，可以把菜单或菜单项屏蔽或删除，如下面的代码所示。

Sub Shibar()With Application.CommandBars("Worksheet menu bar").Reset.Controls("工具(&T)").Controls("宏(&M)").Enabled = False.Controls("数据(&D)").DeleteEnd With
End Sub

代码解析：
Shibar过程屏蔽 “工具”菜单中的“宏”菜单项，删除菜单栏中的“数据”菜单。
第3行代码，使用Reset方法重置工作表菜单栏。
第4行代码，将“宏”菜单项的Enabled属性设置为False，使之无效。
Enabled属性决定命令栏或命令栏控件是否激活，如果将该属性设置为 False，那么该菜单项将无效。
第5行代码，使用Delete方法将“数据”菜单从工作表菜单栏中删除。
Delete方法应用于命令栏或命令栏控件时，从集合中删除指定对象，语法如下：

expression.Delete(Temporary)

参数expression是必需的，返回命令栏或命令栏控件对象之一。
参数Temporary是可选的，设置为True将从当前会话中删除控件，应用程序在下次会话时将再次显示控件。
运行Shibar过程，将屏蔽工作表“工具”菜单中的“宏”菜单项和删除工作表菜单栏中的“数据”菜单，如图 81 1所示。

图 81 1 屏蔽和删除工作表菜单

82. 改变系统菜单的操作

利用VBA甚至可以改变系统菜单的默认操作，使之达到自定义菜单的效果，如下面的代码所示。

Dim WithEvents Saveas As CommandBarButton
Private Sub Workbook_Open()Set Saveas = Application.CommandBars("File").Controls("另存为(&A)...")
End Sub
Private Sub Saveas_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)CancelDefault = TrueMsgBox "本工作簿禁止另存!"
End Sub

代码解析：
第1行代码，在模块级别中使用关键词WithEvents声明变量Saveas是用来响应由CommandBarButton对象触发事件的对象变量。
第2行到第4代码工作簿的Open事件过程，在工作簿打开时将变量Saveas赋值为系统菜单的“另存为”菜单。
因为在声明变量Saveas时使用了关键词WithEvents，不能同时使用New关键词隐式地创建对象，所以在使用变量Saveas之前，必须使用Set语句将变量赋值为一个已有对象。
第5行到第8代码变量Saveas的单击事件过程，改变系统菜单“另存为”的默认操作。
变量Saveas的Click事件在用户单击系统菜单“另存为”时发生，语法如下：

Private Sub CommandBarButton_Click(ByVal Ctrl As CommandBarButton,ByVal CancelDefault As Boolean)

参数Ctrl是必需的，指示初始化该事件的CommandBarButton控件。
参数CancelDefault是必需的，Boolean类型，如果执行了与CommandBarButton控件关联的默认操作，该值为False。除非其他过程或加载项取消了此操作。
第6、7行代码，将CancelDefault参数设置为True，使单击“另存为”菜单时并不执行默认操作而只显示一个消息框。
将工作簿保存、关闭后，重新打开，单击“另存为”菜单并不执行默认操作，只显示一个消息框，如图 82 1所示。

图 82 1 改变系统菜单的默认操作

83. 定制自己的系统菜单

使用VBA开发的小型应用系统完成后，Excel原有的菜单栏完全可以舍弃不用，只使用自定义的菜单栏，更加方便快捷，如下面的代码所示。

Sub AddNowBar()Dim NewBar As CommandBarOn Error Resume NextWith Application.CommandBars("Standard").Visible = False .CommandBars("Formatting").Visible = False .CommandBars("Stop Recording").Visible = False.CommandBars("toolbar list").Enabled = False.CommandBars.DisableAskAQuestionDropdown = True.DisplayFormulaBar = False .CommandBars("NewBar").DeleteEnd WithSet NewBar = Application.CommandBars.Add(Name:="NewBar", Position:=msoBarTop, MenuBar:=True, Temporary:=True)With NewBar.Visible = TrueWith .Controls.Add(Type:=msoControlPopup).Caption = "系统设置(&X)".BeginGroup = TrueWith .Controls.Add(Type:=msoControlButton).Caption = "保存(&S)".BeginGroup = True.FaceId = 1975End WithWith .Controls.Add(Type:=msoControlButton).Caption = "备份(&B)".BeginGroup = True.FaceId = 747End WithEnd WithWith .Controls.Add(Type:=msoControlPopup).Caption = "会计凭证(&P)".BeginGroup = TrueWith .Controls.Add(Type:=msoControlButton).Caption = "录入(&L)".BeginGroup = True.FaceId = 197End WithWith .Controls.Add(Type:=msoControlButton).Caption = "审核(&S)".BeginGroup = True.FaceId = 714End WithEnd WithWith .Controls.Add(Type:=msoControlPopup).Caption = "会计账簿(&Z)".BeginGroup = TrueWith .Controls.Add(Type:=msoControlButton).Caption = "记账(&L)".BeginGroup = True.FaceId = 65End WithWith .Controls.Add(Type:=msoControlButton).Caption = "结账(&S)".BeginGroup = True.FaceId = 47End WithEnd WithWith .Controls.Add(Type:=msoControlPopup).Caption = "会计报表(&B)".BeginGroup = TrueWith .Controls.Add(Type:=msoControlPopup).Caption = "资产负债表(&Y)".BeginGroup = TrueWith .Controls.Add(Type:=msoControlButton).Caption = "月报(&M)".BeginGroup = True.FaceId = 1180End WithWith .Controls.Add(Type:=msoControlButton).Caption = "年报(&Y)".BeginGroup = True.FaceId = 1188End WithEnd WithWith .Controls.Add(Type:=msoControlPopup).Caption = "损益表(&S)".BeginGroup = TrueWith .Controls.Add(Type:=msoControlButton).Caption = "月报(&M)".BeginGroup = True.FaceId = 1180End WithWith .Controls.Add(Type:=msoControlButton).Caption = "年报(&Y)".BeginGroup = True.FaceId = 1188End WithEnd WithEnd WithWith .Controls.Add(Type:=msoControlButton).Caption = "退出系统(&C)".BeginGroup = True.Style = msoButtonCaptionEnd WithEnd WithSet NewBar = Nothing
End Sub

代码解析：
AddNowBar过程使用Add方法创建自定义菜单栏替换工作表菜单栏。
第2行代码定义变量NwBar为命令栏。
第3行代码忽略错误语句，以免第11行代码在删除可能不存在的“NewBar”菜单栏时发生错误。
第5行代码隐藏“常用”工具栏。
第6行代码隐藏“格式”工具栏。
第7行代码隐藏“停止录制”工具栏。
第8行代码屏蔽工具栏的右键快捷菜单。
第9行代码屏蔽工具栏的“键入需要帮助的问题”下拉框。
第10行代码屏蔽工具栏的编辑栏。
第11行代码，在添加命令栏前先删除“NewBar”菜单栏，以免重复增加。
第13行代码，使用Add方法创建命令栏。Add方法应用于CommandBars对象的语法如下：

expression.Add(Name, Position, MenuBar, Temporary)

参数expression是必需的，返回一个CommandBars对象，该对象代表应用程序中的命令栏，新建命令栏的控件均以该对象为载体。
参数Name是可选的，设置新建命令栏的标题。如果忽略该参数，则为新建命令栏指定默认标题，本例中设置新建命令栏的标题为“NewBar”。
参数Position是可选的，设置新建命令栏的位置或类型，可以为表格 83 1所列的 MsoBarPosition常数之一。
常数 说明
msoBarLeft、msoBarTop、msoBarRight 和 msoBarBottom 指定新命令栏的左侧、顶部、右侧和底部坐标
msoBarFloating 指定新命令栏不固定
msoBarPopup 指定新命令栏为快捷菜单
msoBarMenuBar 仅适用于 Macintosh 机
表格 83 1 MsoBarPosition 常数
本例中设置“NewBar”命令栏的Position参数为msoBarTop，使“NewBar”命令栏位于Excel窗口的顶部。
参数MenuBar是可选的，设置为True 将以新命令栏替换活动菜单栏，默认值为False。
在本例中，设置“NewBar”命令栏的MenuBar属性为True，以“NewBar”命令栏替换活动菜单栏。
参数Temporary是可选的，设置为True将使新建命令栏为临时命令栏，在关闭应用程序时删除，默认值为False。
在本例中，设置“NewBar”命令栏的Temporary属性为True，使“NewBar”命令栏为临时命令栏，在关闭应用程序时删除。
第15行代码，设置“NewBar”命令栏为可见的。
第16行到95行代码，使用Add方法在“NewBar”命令栏中添加菜单、菜单项及子菜单并设置其各项属性，参阅技巧79 。
恢复Excel原有的菜单栏的代码如下：

Sub DelNowBar()On Error Resume NextWith Application.CommandBars("Standard").Visible = True.CommandBars("Formatting").Visible = True.CommandBars("Stop Recording").Visible = True.CommandBars("toolbar list").Enabled = True.CommandBars.DisableAskAQuestionDropdown = False.DisplayFormulaBar = True.CommandBars("NewBar").DeleteEnd With
End Sub

代码解析：
DelNowBar过程取消 “常用”、“格式”和“停止录制”工具栏的的隐藏，恢复“键入需要帮助的问题”下拉框和编辑栏，删除“NewBar”命令栏。
运行AddNowBar过程，工作表菜单栏如图 83 1所示。

图 83 1 定制自己的系统菜单

84. 改变菜单按钮图标

利用VBA可以改变系统菜单的默认图标，使之达到自定义按钮图标的效果，如下面的代码所示。

Sub myCbarCnt()Dim myCbarCnt As CommandBarControlWith Sheet1.Shapes.AddShape(17, 1000, 1000, 30, 30).Fill.ForeColor.SchemeColor = 29.CopyPicture.DeleteEnd WithSet myCbarCnt = Application.CommandBars("Standard").Controls(1)myCbarCnt.PasteFaceSet myCbarCnt = Nothing
End Sub
Sub DelmyCbarCnt()Application.CommandBars("Standard").Controls(1).Reset
End Sub

代码解析：
myCbarCnt过程改变系统菜单的“新建”按钮的图标。
第3行代码使用Shape对象的AddShape方法在工作表中新建一个自选图形。应用于Shape对象的AddShape方法请参阅技巧53 。
在本例中将新建图形的Left参数和Top参数设置为较大的数值使新建的自选图形不在当前窗口的可视区域内。
第4行代码设置新建自选图形的颜色。
第5行代码使用CopyPicture方法将新建自选图形作为图片复制到剪贴板。CopyPicture方法的语法如下：

expression.CopyPicture(Appearance, Format)

参数expression是必需的，一个有效的对象。
参数Appearance是可选的，指定图片的复制方式。
参数Format是可选的，图片的格式。
第6行代码使用Delete方法删除新建的自选图形。
第8行代码使用Set语句将系统菜单的“新建”按钮赋给变量myCbarCnt。
第9行代码PasteFace方法将新建的自选图形粘贴到“新建”按钮中。PasteFace方法将“剪贴板”的内容粘贴到指定命令栏按钮控件上，语法如下：

expression.PasteFace

参数expression是必需的，返回一个CommandBarButton对象。
DelmyCbarCnt过程使用Reset方法恢复“新建”按钮的默认图标。
运行myCbarCnt过程结果如图 84 1所示。

图 84 1 改变“新建”按钮的图标

85. 右键快捷菜单增加菜单项

在Excel的右键快捷菜单中可以添加新的菜单项，如下面的代码所示。

Sub MyCmb()Dim MyCmb As CommandBarButtonWith Application.CommandBars("Cell").ResetSet MyCmb = .Controls.Add(Type:=msoControlButton, _ID:=2521, Before:=.Controls.Count, Temporary:=True)MyCmb.BeginGroup = TrueEnd WithSet MyCmb = Nothing
End Sub

代码解析：
MyCmb过程使用Add方法在Excel的右键快捷菜单中添加内置的“打印”菜单项。
在使用Add方法添加菜单项时将Id参数设置为2521，添加的就是内置的“打印”菜单项。将Before属性设置成右键快捷菜单中最后一个控件的值，使“打印”菜单项添加到右键快捷菜单中最后一个控件之前。将Temporary参数设置成True，在关闭应用程序时从右键快捷菜单中删除“打印”菜单项。
运行MyCmb过程，将在Excel右键快捷菜单中添加 “打印”菜单项，如图 85 1所示

图 85 1 在右键快捷菜单中添加菜单项

86. 自定义右键快捷菜单

在工作表中创建自定义的右键快捷菜单替换Excel默认的右键快捷菜单，如下面的代码所示。

Sub Mycell()With Application.CommandBars.Add("Mycell", msoBarPopup)With .Controls.Add(Type:=msoControlButton).Caption = "会计凭证".FaceId = 9893End WithWith .Controls.Add(Type:=msoControlButton).Caption = "会计账簿".FaceId = 284End WithWith .Controls.Add(Type:=msoControlPopup).Caption = "会计报表"With .Controls.Add(Type:=msoControlButton).Caption = "月报".FaceId = 9590End WithWith .Controls.Add(Type:=msoControlButton).Caption = "季报".FaceId = 9591End WithWith .Controls.Add(Type:=msoControlButton).Caption = "年报".FaceId = 9592End WithEnd WithWith .Controls.Add(Type:=msoControlButton).Caption = "凭证打印".FaceId = 9614.BeginGroup = TrueEnd WithWith .Controls.Add(Type:=msoControlButton).Caption = "账簿打印".FaceId = 707End WithWith .Controls.Add(Type:=msoControlButton).Caption = "报表打印".FaceId = 986End WithEnd With
End Sub

代码解析：
Mycell过程在Excel工作表中创建自定义的右键快捷菜单。
第2行代码，使用Add方法添加名称为“Mycell”命令栏，设置“Mycell”命令栏的Position属性为msoBarPopup，使“Mycell”命令栏为快捷菜单。关于Position参数的MsoBarPosition常数请参阅技巧83 中的表格 83 1。
第3行到第39行代码，使用Add方法在“Mycell”命令栏中添加菜单和菜单项，并设置其各项属性。
为了让自定义右键快捷菜单替换Excel默认的右键快捷菜单，并且只在右键单击Sheet1工作表时显示，需要在Sheet1工作表的BeforeRightClick事件中写入下面的代码。

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)Application.CommandBars("Mycell").ShowPopupCancel = True
End Sub

代码解析：
工作表的BeforeRightClick事件过程，在右键单击工作表时，将“Mycell”命令栏作为右键快捷菜单，在当前光标位置显示。
工作表BeforeRightClick事件语法如下：

Private Sub expression_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

参数expression是必需的，Worksheet类型对象。
参数Target 是可选的，右键单击发生时最靠近鼠标指针的单元格。
参数Cancel是可选的，当事件发生时为False。如果在事件过程中将Cancel参数设为True，则该过程执行结束之后不进行默认的右键单击操作。
第2行代码，使用ShowPopup方法将“Mycell”命令栏作为右键快捷菜单，在当前光标位置显示。
ShowPopup方法的语法如下：

expression.ShowPopup(x, y)

参数expression是必需的，返回一个CommandBar对象。
参数x是可选的，快捷菜单所在位置的 x 坐标。如果省略此参数，将使用当前光标位置的x坐标。
参数y是可选的，快捷菜单所在位置的y坐标。如果省略此参数，将使用当前光标位置的y坐标。
当用鼠标右键单击工作表中任意单元格时激活BeforeRightClick事件，此事件先于默认的右键单击操作。在使用ShowPopup方法显示“Mycell”命令栏后，将Cancel参数设置为True，过程执行结束之后不进行默认的右键单击操作，Excel右键快捷菜单就不会显示。
运行Mycell过程后，右键单击Sheet1工作表，在工作表中显示自定义右键快捷菜单，如图 86 1所示。

图 86 1 自定义右键快捷菜单

87. 使用右键菜单制作数据有效性

在工作表中输入数据时可以使用自定义右键菜单制作数据有效性，如下面的代码所示。

Sub Mycell()Dim arr As VariantDim i As IntegerDim Mycell As CommandBarOn Error Resume NextApplication.CommandBars("Mycell").Deletearr = Array("经理室", "办公室", "生技科", "财务科", "营业部")Set Mycell = Application.CommandBars.Add("Mycell", 5)For i = 0 To 4With Mycell.Controls.Add(1).Caption = arr(i).OnAction = "MyOnAction"End WithNext
End Sub
Sub MyOnAction()ActiveCell = Application.CommandBars.ActionControl.Caption
End Sub

代码解析：
Mycell过程创建自定义的右键菜单，请参阅技巧86 。
MyOnAction过程是点击自定义右键菜单所运行的过程，将所选右键菜单的名称写入活动单元格。
为了使自定义的右键菜单在Sheet1工作表的特定区域中显示，需要在VBE中双击Sheet1表后写入下面的代码。

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)If Target.Column = 2 ThenCall MycellApplication.CommandBars("Mycell").ShowPopupCancel = TrueEnd If
End Sub

代码解析：
工作表的BeforeRightClick事件过程，在右键单击工作表时，将“Mycell”命令栏作为右键快捷菜单，在当前光标位置显示，请参阅技巧86 。
在工作表的B列中点击右键结果如图 87 1所示。

图 87 1 使用右键菜单制作数据有效性

88. 禁用工作表右键菜单

有时并不希望用户使用工作表中的右键菜单对工作表进行操作，那么可以使用下面的代码禁用工作表右键菜单。

Sub DisBar()Dim myBar As CommandBarFor Each myBar In CommandBarsIf myBar.Type = msoBarTypePopup ThenmyBar.Enabled = FalseEnd IfNext
End Sub

代码解析：
DisBar过程禁用工作表中所有的右键菜单。
第3行代码使用For Each…Next 语句遍历CommandBars集合。CommandBars集合代表应用程序中所有的命令栏。
第4行代码根据命令栏的Type属性判断命令栏是否为右键菜单。应用于 CommandBar对象的Type属性返回命令栏的类型，可以为表格 88 1所列的MsoBarType 常量之一。
常量 值 描述
msoBarTypeMenuBar 1 菜单栏
msoBarTypeNormal 0 工具栏
msoBarTypePopup 2 右键快捷菜单
表格 88 1 MsoBarType 常量
第5行代码将CommandBars集合中右键快捷菜的Enabled属性设置为False，使之无效。
运行DisBar过程将禁用工作表中所有的右键菜单，需要恢复时只需将其Enabled属性设置为True即可。

89. 创建自定义工具栏

为了方便用户操作，在Excel原有的的工具栏上，还可以创建自定义的工具栏，如下面的代码所示。

Sub NowToolbar()Dim arr As VariantDim id As VariantDim i As IntegerDim Toolbar As CommandBarOn Error Resume NextApplication.CommandBars("MyToolbar").Deletearr = Array("会计凭证", "会计账簿", "会计报表", "凭证打印", "账簿打印", "报表打印")id = Array(9893, 284, 9590, 9614, 707, 986)Set Toolbar = Application.CommandBars.Add("MyToolbar", msoBarTop)With Toolbar.Protection = msoBarNoResize.Visible = TrueFor i = 0 To 5With .Controls.Add(Type:=msoControlButton).Caption = arr(i).FaceId = id(i).BeginGroup = True.Style = msoButtonIconAndCaptionBelowEnd WithNextEnd WithSet Toolbar = Nothing
End Sub

代码解析：
NowToolbar过程使用Add方法在Excel窗口中创建自定义工具栏。应用于CommandBars对象的Add方法请参阅技巧83 。
第10行代码，使用Add方法在菜单栏上创建名称为“MyToolbar”的命令栏，创建时设置新命令栏的Position参数为msoBarTop，使新命令栏位于应用程序窗口的顶部。如果将Position参数设置成msoBarFloating，新命令栏为浮动工具栏，如图 89 1所示。

图 89 1 浮动命令栏
关于Position参数的MsoBarPosition常数请参阅技巧83 中的表格 83 1。
第12行代码，设置“MyToolbar”命令栏的Protection属性为msoBarNoResize。应用于CommandBar对象的Protection属性指定命令栏的保护类型，可以为表格 89 1所列的MsoBarProtection常数之一。
常数 值 说明
msoBarNoProtection 0 不受保护，可自定义(缺省值)
msoBarNoCustomize 1 不能自定义
msoBarNoResize 2 不能调整大小
msoBarNoMove 4 不能移动
msoBarNoChangeVisible 8 不能更改可见状态
msoBarNoChangeDock 16 不能改变停靠的位置
msoBarNoVerticalDock 32 不能沿窗口左侧或右侧停放
msoBarNoHorizontalDock 64 不能沿窗口顶部或底部停放
表格 89 1 MsoBarProtection常数
第14行到第21代码，使用Add方法在新命令栏中添加按钮控件，设置按钮控件的各项属性。其中第19行代码，设置按钮控件的Style属性为msoButtonIconAndCaptionBelow，使工具栏按钮显示时包含图标和标题，且标题位于图标之下。
应用于CommandBar对象的Style属性返回或设置工具栏按钮的显示方式，可以为表格 89 2所列的MsoButtonStyle常数之一。
常数 值 说明
msoButtonIcon 1 包含图标的按钮
msoButtonCaption 2 包含标题的按钮
ButtonIconandCaption 3 包含图标和标题的按钮
msoButtonIconAndCaptionBelow 11 包含图标和标题，且标题位于底部的按钮
msoButtonIconAndWrapCaption 7 包含图标和标题，且标题自动换行的按钮
msoButtonWrapCaption 14 包含标题，且标题自动换行的按钮
表格 89 2 MsoButtonStyle常数
运行NowToolbar过程，将在Excel窗口的顶部创建一个自定义的工具栏，如图 89 2所示。

图 89 2 创建自定义工具栏

90. 自定义工具栏按钮图标

在创建自定义的工具栏时，除了可以为工具栏按钮添加Excel内置的图标外，还能为工具栏按钮添加自定义的图标，如下面的代码所示。

Sub AddCustomButton()Dim xBar As CommandBarDim xButton As CommandBarButtonOn Error Resume NextApplication.CommandBars("CustomBar").DeleteSet xBar = CommandBars.Add("CustomBar", msoBarTop)Set xButton = xBar.Controls.Add(msoControlButton)With xButton.Picture = LoadPicture(ThisWorkbook.Path & "\P.BMP").Mask = LoadPicture(ThisWorkbook.Path & "\M.BMP").TooltipText = "Excel Home 论坛"End WithxBar.Visible = TrueSet xBar = NothingSet xButton = Nothing
End Sub

代码解析：
AddCustomButton过程创建自定义工具栏，并设置工具栏的按钮自定义图标。
第6、7行代码，使用Add方法在Excel窗口中添加自定义工具栏和按钮。请参阅技巧89 。
第9行代码，设置工具栏按钮的Picture属性为同一目录中的p.bmp图片。
应用于CommandBarButton 对象的Picture属性返回一个IPictureDisp对象，表示 CommandBarButton对象的图像，语法如下：

expression.Picture

参数是必需的，返回一个CommandBarButton对象。
指定对象的Picture属性就能设置对象的图像。
第10行代码，设置工具栏按钮的Mask属性为同一目录中的m.bmp图片。
为了使工具栏按钮图标透明显示，在指定对象的Picture属性后，还需要指定对象的Mask属性。
应用于CommandBarButton 对象的Mask属性返回表示CommandBarButton对象的屏蔽图像的IPictureDisp对象，语法如下：

expression.Mask

参数是必需的，返回一个CommandBarButton对象。
屏蔽图像决定按钮图像透明的部分。在创建作为屏蔽图像使用的图像时，所有要透明的区域应该为白色，所有要显示的区域应该为黑色。
第11行代码，设置按钮的“屏幕提示”为“ExcelHome论坛”。
运行AddCustomButton过程，创建自定义工具栏，并设置工具栏按钮的图标，如图 90 1所示。

图 90 1 自定义工具栏图标

91. 自定义工作簿图标

Excel标题栏的图标是默认的，而借助API函数可以自定义工作簿标题栏图标，如下面的代码所示。

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Const WM_SETICON = &H80
Private Sub Workbook_Open()Dim IStyle As LongDim hIcon As LongDim hWndForm As LonghWndForm = FindWindow(vbNullString, Application.Caption)hIcon = ExtractIcon(0, ActiveWorkbook.Path & "\p.bmp", 0)SendMessage hWndForm, WM_SETICON, True, hIconSendMessage hWndForm, WM_SETICON, False, hIcon
End Sub

代码解析：
工作簿打开后使用API函数自定义工作簿标题栏的图标。
第1行到第6行代码，API函数声明。
第7行到第15行代码，工作簿的Open事件过程，把工作簿标题栏默认的图标更改为同一文件夹下的p.bmp图片。
工作簿打开后标题栏如图 91 1所示，任务栏图标如图 91 2所示。

图 91 1 自定义工作簿标题和图标

图 91 2 任务栏图标

92. 移除工作表的最小最大化和关闭按钮

如果不希望工作表的最小、最大化和关闭按钮出现在菜单栏中，可以使用以下代码去除：
ActiveWorkbook.Protect , , True
代码解析：
使用Protect方法对工作簿进行保护。Protect方法应用于Workbook对象的时保护工作簿使其不至被修改，语法如下：

expression.Protect(Password, Structure, Windows)

参数expression是必需的，该表达式返回一个Workbook对象。
参数Password是可选的，为工作表或工作簿指定区分大小写的密码。
参数Structure是可选的，如果为True，则保护工作簿结构（工作表的相对位置）。默认值为False。
参数Windows是可选的，如果为True，则保护工作簿窗口。
恢复工作表的最大、最小化和关闭按钮的代码如下：
ActiveWorkbook.Protect , , False
在本例中将Windows参数设置为True，使工作簿窗口受到保护，工作表的最小、最大化和关闭按钮及图标不出现在菜单栏中，如图 92 1所示。

图 92 1 移除工作表最小、最大化和关闭按钮

93. 在工具栏上添加下拉列表框

如果需要在工具栏中添加类似“字体”这样的下拉列表控制框控件，那么可以使用下面的代码。

Sub AddDropdown()Dim myDropdown As ObjectDim myCap As VariantDim i As IntegermyCap = Array("基础应用", "VBA程序开发", "函数与公式")Call DeleteButtonSet myDropdown = Application.CommandBars("Formatting").Controls _.Add(Type:=msoControlDropdown, Before:=1)With myDropdown.Caption = "请选择版块".OnAction = "myOnA".Style = msoComboNormalFor i = 0 To UBound(myCap).AddItem myCap(i)Next.ListIndex = 1End With
End Sub
Sub DeleteButton()With Application.CommandBars("Formatting").Controls(1)If .Caption = "请选择版块" Then .DeleteEnd With
End Sub
Sub myOnA()Dim myList As BytemyList = Application.CommandBars("Formatting") _.Controls(1).ListIndexActiveWorkbook.FollowHyperlink _Address:="http://club.excelhome.net/forum-" & myList & "-1.html", NewWindow:=True
End Sub

代码解析：
AddDropdown过程使用Add方法在工具栏中添加下拉列表控制框控件。
第5行代码使用Array函数创建一个数组用于保存下拉列表控制框控件加载列表项所需的元素。
第6行代码先运行第19行到第23行的DeleteButton过程删除可能存在的下拉列表控制框控件，以免重复添加。DeleteButton过程判断工具栏中第一个控件的Caption属性是否为“请选择版块”，如果是则删除该下拉列表控制框控件。
第7、8行代码使用Add方法在工具栏中添加下拉列表控制框控件。应用于 CommandBarControls 对象的Add方法请参阅技巧79 。示例中将其参数Type设置为msoControlDropdown，添加的就是下拉列表控制框控件。
第10行代码设置下拉列表控制框控件的Caption属性，应用于 CommandBarControls 对象的Caption属性返回或设置指定命令栏控件的题注文字，也可作为默认的“屏幕提示”显示。
第11行代码设置改变下拉列表控制框控件的内容时要运行的过程为第24行到第30行代码的myOnA过程。myOnA过程根据下拉列表控制框控件的ListIndex属性值打开Excel Home论坛中相应的版块。
第12行代码设置下拉列表控制框控件的样式。Style属性返回或设置命令栏控件的显示方式，该属性值可设置为表格 93 1所列MsoComboStyle常量之一。
常量 值 描述
msoComboLabel 1 显示标签
msoComboNormal 0 不显示标签
表格 93 1 MsoComboStyle常量
第13行到第15行代码使用AddItem方法将数组中的元素添加到下拉列表控制框控件的列表项中。
第16行代码将下拉列表控制框控件的ListIndex属性设置为1，使其显示第一条列表项。
运行AddDropdown过程，工具栏如图 93 1所示。

图 93 1 添加下拉列表控制框控件

94. 屏蔽工作表的复制功能

有时我们并不希望用户对工作表中的数据进行复制粘贴操作，此时可以把所有的复制功能都屏蔽，如下面的代码所示。

    Dim CmdCtrls As CommandBarControlsDim Cmd As CommandBarControl
Sub ProCopy()Set CmdCtrls = Application.CommandBars.FindControls(ID:=19)For Each Cmd In CmdCtrlsCmd.Enabled = FalseNextApplication.CellDragAndDrop = FalseApplication.OnKey ("^c"), ""
End Sub
Sub StaCopy()Set CmdCtrls = Application.CommandBars.FindControls(ID:=19)For Each Cmd In CmdCtrlsCmd.Enabled = TrueNextApplication.CellDragAndDrop = TrueApplication.OnKey ("^c")
End Sub

代码解析：
第1、2行代码在模块顶部声明两个模块级的变量。
第3行到第10行代码ProCopy过程，屏蔽工作表中所有的复制功能。其中第4行到第7行代码使用FindControls方法将所有与“复制”相关的命令栏控件赋给变量CmdCtrls后将其Enabled设置为False。关于FindControls方法请参阅技巧80 。
第8行代码屏蔽单元格拖放功能，关于应用于Application对象的CellDragAndDrop属性请参阅技巧10 。
第9行代码屏蔽<Ctrl+C>组合键功能，关于应用于Application 对象的OnKey方法请参阅技巧68 。
第11行到第18行代码StaCopy过程，恢复所有的复制功能。

95. 禁用工具栏的自定义

在Excel中，用户可以通过依次单击菜单“视图”→“工具栏”→“自定义”，显示“自定义”选项卡来调整菜单栏和工具栏，如图 95 1、图 95 2所示。

图 95 1 自定义功能

图 95 2 自定义选项卡
如果不希望用户使用“自定义”选项卡来调整菜单栏和工具栏，可以禁用工具栏的自定义功能，如下面的代码所示。

Sub nCustomize()Application.CommandBars.DisableCustomize = True
End Sub

代码解析：
nCustomize 过程禁用工具栏的自定义功能，应用于CommandBars 集合对象的DisableCustomize属性设置是否禁用工具栏的自定义。如果禁用，返回True，否则返回False。
用于启用工具栏的自定义的代码是：

Sub yCustomize()Application.CommandBars.DisableCustomize = False
End Sub

运行nCustomize过程，禁用工具栏的自定义对话框，自定义菜单项消失,如图 95 3所示。

图 95 3 禁用工具栏的自定义

96. 屏蔽所有的命令栏

在使用自定义的操作界面时，需要屏蔽Excel中所有的命令栏，可以使用下面的代码。

Sub Shielding_1()Dim i As IntegerFor i = 1 To Application.CommandBars.CountApplication.CommandBars(i).Enabled = FalseNext
End Sub

代码解析：
Shielding_1过程使用For…Next语句遍历Excel命令栏，并将其Enabled属性设置为False，使之无效。
还可以使用For Each…Next 语句遍历所有的CommandBars对象，代码如下：

Sub Shielding_2()Dim Cmd As CommandBarFor Each Cmd In Application.CommandBarsCmd.Enabled = FalseNext
End Sub

运行Shielding_1或Shielding_2过程工作簿如图 96 1所示。

图 96 1 屏蔽所有的命令栏
在需要恢复时只需将Enabled属性设置为True即可，如下面的代码所示。

Sub Recovery_1()Dim i As IntegerFor i = 1 To Application.CommandBars.CountApplication.CommandBars(i).Enabled = TrueNext
End Sub
Sub Recover_2()Dim Cmd As CommandBarFor Each Cmd In Application.CommandBarsCmd.Enabled = TrueNext
End Sub

代码解析：
Recovery_1和Recover_2过程分别使用For…Next语句和For Each…Next 语句遍历所有的CommandBars对象，设置其Enabled属性为True，显示所有的命令栏。

97. 恢复Excel的命令栏

如果用户经常添加、删除Excel的菜单和工具栏而又没有及时恢复的话，有时会破坏Excel默认的用户界面，即使用Reset方法也不能恢复成初始状态。
此时可以在电脑的本地硬盘中查找扩展名为*.xlb的文件，该文件在电脑中的位置会因Excel版本的不同而不同，在XP操作系统中，该文件位于系统盘的Documents and Settings\Administrator\Application Data\Microsoft\Excel文件夹，其中Administrator是电脑的用户名。找到它最简单的方法是使用Windows的搜索功能。按<Win+F>组合键调出Windows的搜索窗口，然后用*.xlb为目标在本地硬盘中进行搜索，如图 97 1所示。

图 97 1 搜索*.xlb文件
如果搜索没有结果，请检查“更多高级选项”中是否选中“搜索隐藏的文件和文件夹”选项，如图 97 2所示。

图 97 2 搜索隐藏的文件和文件夹
对Excel用户界面的任何修改都会保存在*.xlb文件中，找到后删除该文件，然后重新启动Excel。Excel会重新创建一个*.xlb文件，而菜单和工具栏也会全部恢复成初始状态。

第八章 控件与用户窗体

98. 限制文本框的输入

用户在使用文本框输入数据时，往往希望能限制输入数据的类型，比如只能输入数字。但是没有内置的属性能限制在文本框中只能输入数字，只能在文本框的事件过程中使用代码来测试输入的是哪类字符，然后只允许输入数字字符和一个“-”号、一个“.”号，如下面的代码所示。

Private Sub TextBox1_KeyPress(ByVal KeyANSI As MSForms.ReturnInteger)Select Case KeyANSICase Asc("0") To Asc("9")Case Asc("-")If InStr(1, Me.TextBox1.Text, "-") > 0 Or _Me.TextBox1.SelStart > 0 ThenKeyANSI = 0End IfCase Asc(".")If InStr(1, Me.TextBox1.Text, ".") > 0 ThenKeyANSI = 0End IfCase ElseKeyANSI = 0End Select
End Sub

代码解析：
文本框的KeyPress事件过程，测试键盘输入的是哪类字符，只允许输入数字字符和一个“-”号、一个“.”号。
KeyPress事件的语法如下：

Private Sub object_KeyPress( ByVal KeyANSI As MSForms.ReturnInteger)

参数Object是必需的，一个有效的对象。
参数KeyANSI是可选的，整数值，代表标准的数字ANSI 键代码。
第2行代码使用Case Else语句测试文本框KeyPress事件的KeyANSI参数值。
第3行代码，如果键盘输入的是0到9之间的数字字符，则允许输入。如果想在文本框中允许其它类型的字符输入，在此句代码中列出允许输入的字符即可。
第4行到第8行代码，如果键盘输入的是“-”号，先使用InStr函数测试文本框中是否已有“-”号，如果InStr函数返回值大于0，说明文本框中已有“-”号。接下来使用文本框的SelStart 属性来测试插入点，如果文本框的SelStart 属性值大于0，说明“-”号的插入点不是第一个。如果以上两个条件中有任何一个成立，将KeyAscii参数值设置为0，使文本框只能在第一位输入一个“-”号。
第9行到第12行代码，如果键盘输入的是“.”号的话，使用InStr函数测试文本框中是否已有“.”号，如果已有“.”号，将KeyAscii参数值设置为0，使文本框只能输入一个“.”号。
第13、14行代码，如果键盘输入的是其他字符则将KeyAscii参数值设置为0，使文本框不能输入其他字符。
经过以上设置文本框只允许输入数字字符和一个“-”号、一个“.”号，但是能输入中文字符。如果希望限制中文字符的输入，可以在文本框的Change事件中进行设置，如下面的代码所示。

Private Sub TextBox1_Change()Dim i As IntegerDim s As StringWith TextBox1For i = 1 To Len(.Text)s = Mid(.Text, i, 1)Select Case sCase ".", "-", "0" To "9"Case Else.Text = Replace(.Text, s, "")End SelectNextEnd With
End Sub

代码解析：
文本框的Change事件，判断输入的字符是否为数字字符和“-”号、“.”号，如果不是则使用Replace函数将文本框中输入的其他字符替换成空白。
第5、6行代码在文本框输入的所有字符中循环。
第8行代码列出允许输入的字符。如果想在文本框中允许其它字符输入，在此句代码中列出即可。
第9、10行代码，如果不是允许输入的字符，使用Replace函数替换成空白。
经过以上的设置，文本框中只能在第一位输入一个“-”号、一个“.”号和“0”到“9”的数字。

99. 文本框添加右键快捷菜单

VBA中的控件没有提供右键快捷菜单，用户可以使用Excel 中的命令栏自已添加右键快捷菜单。
步骤1：按<Alt+F11>组合键进入VBE窗口，单击菜单“插入”→“模块”，在其代码窗口输入以下代码：

Private ActiveTB As MSForms.TextBox
Public Sub CreateShortCutMenu()Dim ShortCutMenu As CommandBarDim ShortCutMenuItem As CommandBarButtonDim sCaption As VariantDim iFaceId As VariantDim sAction As VariantDim i As IntegersCaption = Array("剪切(&C)", "复制(&T)", "贴粘(&P)", "删除(&D)")iFaceId = Array(21, 19, 22, 1786)sAction = Array("Action_Cut", "Action_Copy", "Action_Paste", "Action_Delete")On Error Resume NextApplication.CommandBars("ShortCut").DeleteSet ShortCutMenu = Application.CommandBars.Add("ShortCut", msoBarPopup)With ShortCutMenuFor i = 0 To 3Set ShortCutMenuItem = .Controls.Add(msoControlButton)With ShortCutMenuItem.Caption = sCaption(i).faceID = Val(iFaceId(i)).OnAction = sAction(i)End WithNextEnd With
End Sub

代码解析：
第1行代码，在模块级别中声明变量ActiveTB是用来对应窗体中的文本框所触发的所有事件的变量。
CreateShortCutMenu过程用来创建标题为“ShortCut”的右键快捷菜单，并添加4个菜单项。关于自定义右键快捷菜单请参阅技巧86 。

Public Sub ShowPopupMenu(txtCtr As MSForms.TextBox)Dim Action As VariantSet ActiveTB = txtCtrWith Application.CommandBars("ShortCut").Controls(1).Enabled = txtCtr.SelLength > 0.Controls(2).Enabled = .Controls(1).Enabled.Controls(3).Enabled = txtCtr.CanPaste.Controls(4).Enabled = .Controls(1).Enabled.ShowPopupEnd With
End Sub

代码解析：
ShowPopupMenu过程根据文本框中字符的选中状态设置右键快捷菜单菜单项的Enabled属性后使用ShowPopup方法显示右键快捷菜单。
第5行代码，如果当前文本框中已有选中的字符则“剪切”按钮有效。
第6行代码，如果当前文本框中已有选中的字符则“复制”按钮有效。
第7行代码，如果剪贴板中包含对象支持的数据。则“贴粘”按钮有效。
第8行代码，如果当前文本框中已有选中的字符则“删除”按钮有效。
第9行代码，显示快捷菜单。

Public Sub Action_Cut()ActiveTB.Cut
End Sub
Public Sub Action_Copy()ActiveTB.Copy
End Sub
Public Sub Action_Paste()ActiveTB.Paste
End Sub
Public Sub Action_Delete()Dim s As StringWith ActiveTBs = .SelText.Value = Replace(.Value, s, "")End With
End Sub

代码解析：
Action_Cut过程是快捷菜单中单击“剪切”菜单项所运行的过程。使用Cut 方法将当前选中的文本框中的文本删除并移至剪贴板。
Action_Copy过程是快捷菜单中单击“复制”菜单项所运行的过程。使用Copy方法将文本框选中的文本复制到剪贴板上。
Action_Paste过程是快捷菜单中单击“贴粘”菜单项所运行的过程。使用Paste方法把剪贴板上的内容传送到一个文本框中。
Action_Delete过程是快捷菜单中单击“贴粘”菜单项所运行的过程。使用Replace函数将文本框中选中的文本的文本替换成空字符。

Public Sub DeleteShortCutMenu()On Error Resume NextApplication.CommandBars("ShortCut").Delete
End Sub

代码解析：
DeleteShortCutMenu过程删除创建的右键快捷菜单。
步骤2：在VBE窗口中，单击菜单“插入”→“用户窗体”，在窗体上添加两个文本框控件。双击窗体，在其代码窗口中输入下面的代码。

Private Sub UserForm_Initialize()Call CreateShortCutMenu
End Sub
Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)If Button = 2 Then ShowPopupMenu ActiveControl
End Sub
Private Sub TextBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)If Button = 2 Then ShowPopupMenu ActiveControl
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)Call DeleteShortCutMenu
End Sub

代码解析：
第1行到第3行代码，窗体的Initialize事件，在窗体初始化时运行CreateShortCutMenu过程创建右键快捷菜单。
第4行到第9行代码，文本框的MouseUp事件，当用户右健单击文本框时运行ShowPopupMenu过程在选中的菜单项上显示右键快捷菜单。
第10行到第12行代码，窗体的QueryClose事件，在关闭窗体时运行DeleteShortCutMenu过程删除右键快捷菜单。
窗体运行后，右键单击文本框显示右键快捷菜单，如图 99 1所示。

图 99 1 文本框快捷菜单

100. 文本框回车自动输入

在使用文本框向工作表输入数据时，为了加快输入速度，可以利用文本框的KeyDown事件，回车后自动输入并清空文本框，如下面的代码所示。

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)With TextBox1If Len(Trim(.Value)) > 0 ThenIf KeyCode = vbKeyReturn ThenSheet1.Range("A65536").End(xlUp).Offset(1, 0) = .Value.Text = ""End IfEnd IfEnd With
End Sub

代码解析：
文本框的KeyDown事件，在输入数据并按键后自动将数据录入到工作表A列最后一个非空单元格的下一个单元格中。
KeyDown事件在按下键盘按键时发生，语法如下：

Private Sub object_KeyDown( ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As fmShiftState)

参数object是必需的，一个有效的对象。
参数KeyCode是必需的，代表被按下的键的键代码。
参数Shift是可选的，Shift、Ctrl 和Alt的状态。
第3行代码，为了防止误输入空白数据，使用Len 函数和Trim 函数检查文本框内是否为有效数据。
第4行代码，根据KeyCode参数值判断是否按下了回车键。如果用户按下了回车键，KeyCode参数返回常数vbKeyReturn。
第5、6行代码，将文本框数据输入到工作表A列的最后一个单元格内，同时清空文本框内容准备下一次输入。

101. 自动选择文本框内容

如果希望光标进入文本框时能自动选择文本框内容，可以在文本框的MouseUp事件中来完成，如下面的代码所示。

Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)With TextBox1If Button = 2 Then.SelStart = 0.SelLength = Len(.Text)End IfEnd With
End Sub

代码解析：
文本框的MouseUp事件，在光标进入文本框释放鼠标右键时自动选择文本框内容。
MouseUp事件在用户释放鼠标按键时发生，语法如下：

Private Sub object_MouseUp( ByVal Button As fmButton, ByVal Shift As fmShiftState, ByVal X As Single, ByVal Y As Single)

参数object是必需的，一个有效的对象。
参数Button是可选的，设置引起该事件的鼠标按键的整数值，如表格所示。

常数	值	说明
fmButtonLeft	1	按下左键。
fmButtonRight	2	按下右键。
fmButtonMiddle	3	按下中键。

• 参数Shift：可选的，Shift、Ctrl 和Alt的状态。
  参数X和参数Y是可选的，窗体、框架或页的位置的横坐标与纵坐标。
  第3行到第6行代码，如果用户进入文本框释放鼠标右键，设置文本框的SelStart 属性为0，SelLength属性为文本框的全部字符数。
  SelStart 属性指定选中文本的起点，语法如下：

object.SelStart [= Long]

参数object是必需的，一个有效的对象。
参数Long是可选的，指定选中文本的起点。
SelLength 属性指定文本框或组合框的文本部分中选中的字符数，语法如下：

object.SelLength [= Long]

参数object是必需的，一个有效的对象。
参数Long是可选的，指定选中的字符数。
运行窗体，当光标进入文本框释放鼠标右键时自动选择文本框内容，如图 101 1所示。

图 101 1 自动选择文本框内容

102. 设置文本框数据格式

文本框在用来输入数据时，除了限制输入的数据类型外，还可以设置文本框的数据格式，如下面的代码所示。

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)TextBox1 = Format(TextBox1, "0.00")
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)TextBox2 = Format(TextBox2, "0.00")
End Sub

代码解析：
文本框的Exit事件过程，在文本框输入数据时使用Format函数格式化为两位小数格式。
控件的Exit事件在同一窗体中的一个控件即将把焦点转移到另一个控件之前发生，语法如下：

Private Sub object_Exit( ByVal Cancel As MSForms.ReturnBoolean)

参数Object是必需的，一个有效的对象。
参数Cancel是必需的，事件状态。如果设置为False表示由该控件处理这个事件（默认方式）。设置为True表示由应用程序处理这个事件，并且焦点留在当前控件上。
当文本框在输入完数据失去焦点时使用Format函数格式化自定义数值格式。Format函数语法如下：

Format(expression[, format[, firstdayofweek[, firstweekofyear]]])

参数expression是必需的，任何有效的表达式。
参数format是可选的，有效的命名表达式或用户自定义格式表达式。
参数firstdayofweek是可选的，常数，表示一星期的第一天。
参数firstweekofyear是可选的，常数，表示一年的第一周。
在本例中，将文本框的数据格式化成自定义的两位小数的数值格式，关于Format函数格式化日期和时间等其他数据请参阅VBA中Format函数的帮助。

Private Sub TextBox1_Change()TextBox3 = Format(Val(TextBox1) * Val(TextBox2), "0.00")
End Sub
Private Sub TextBox2_Change()TextBox3 = Format(Val(TextBox1) * Val(TextBox2), "0.00")
End Sub

代码解析：
文本框的Change事件过程，在两个文本框输入完数据后，使用文本框的Change事件使TextBox3显示其相乘的金额并格式化为两位小数的数据格式。
Change事件在控件的 Value 属性改变时发生，语法如下：

Private Sub object_Change( )

参数object是必需的，一个有效的对象。
Change事件过程可以使显示在控件上的数据同步或一致。在本例中，当TextBox1或TextBox2的数据发生改变时，两者相乘的金额的金额也随之改变并在TextBox3中显示。
因为文本框的数据类型是文本字符串，不能直接进行计算的，所以计算前先使用Val函数转换为数字，才能进行计算。
运行窗体，输入数据后格式化为两位小数的数据格式，如图 102 1所示。

图 102 1 设置文本框的数据格式

103. 限制文本框的输入长度

在使用文本框输入数据时，可能希望限制能输入的字符长度，即只能输入一定长度的字符，超过设置数值就不能输入，这时可以通过设置文本框的MaxLength属性来实现，如下面的代码所示。

Private Sub Worksheet_Activate()Me.TextBox1.MaxLength = 6
End Sub

代码解析：
工作表的激活事件过程，将文本框的MaxLength属性设置为6，使文本框只能输入6个字符，超过6个字符即不能输入。
应用于文本框控件的MaxLength属性规定用户可以在文本框中输入的最多字符数，语法如下：

object.MaxLength [= Long]

参数object是必需的，一个有效的对象。
参数Long是可选的，整数，表示所允许的字符数。
如果将MaxLength属性设置为0，表示只要内存允许则没有限制。

104. 将光标返回文本框中

在用文本框往工作表录入数据时，一般会在录入到工作表前验证输入的数据是否正确，如果错误，则清空文本框内容，提示用户重新输入。但此时光标已经不在文本框中，需要重新选择文本框才能输入。
可以在Exit事件中可以设置Cancel参数值使光标停留在当前文本框中，如下面的代码所示。

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)With TextBox1If .Text <> "" And Len(Trim(.Text)) <> 15 And Len(Trim(.Text)) <> 18 Then.Text = ""MsgBox "身份证号码录入错误!"Cancel = TrueEnd IfEnd With
End Sub

代码解析：
文本框的Exit事件，在输入身份证号码后即将把焦点转移到录入按钮控件之前检查输入的身份证号码是否正确。
Exit事件在一个控件从同一窗体的另一个控件实际接收到焦点之前发生,语法如下:

Private Sub object_Exit( ByVal Cancel As MSForms.ReturnBoolean)

Cancel参数为事件状态。False表示由该控件处理这个事件（这是默认方式）。True表示由应用程序处理这个事件，并且焦点应当留在当前控件上。
第3行代码，使用Len函数和Trim函数检查输入的身份证号码是否为15位或18位。
第4行到第6行代码，如果输入的身份证号码不正确，清空文本框以便重新输入并提示用户，设置Cancel参数为True使光标停留在文本框中。
在Exit事件中之所以把文本框为空也做为通过验证的条件之一，因为如果不加上“TextBox1.Text <> “””这一条件，那么在窗体显示后，如果用户取消输入或关闭输入窗体，也会提示输入错误。所以在录入到工作表之前再验证文本框是否为空，如下面的代码所示。

Private Sub CommandButton1_Click()With TextBox1If .Text <> "" ThenSheet1.Range("a65536").End(xlUp).Offset(1, 0) = .Text.Text = ""ElseMsgBox "请输入身份证号码!"End If.SetFocusEnd With
End Sub

代码解析：
输入按钮的Click事件，把文本框数据录入到工作表A列最后一个单元格中并重新选择文本框准备下一次输入。
第3行代码，在输入到工作表前检查文本框是否为空。
第4、5行代码，如果文本框不为空，录入数据到工作表并清空文本框内容。
第7行代码，如果文本框为空，提示用户输入数据。
第8行代码，使用SetFocus方法将光标返回到文本框中以便重新输入。
SetFocus方法将焦点移动到对象的实例中，语法如下 ：

object.SetFocus

参数object.是必需的，一个有效的对象。
运行窗体，在输入框中输入身份证号码后自动验证输入的数据，如果输入数据错误，清空文本框并提示用户重新输入，如图 104 1所示。

图 104 1 提示用户重新输入

105. 文本框的自动换行

在使用使用文本框显示或录入一段很长的文本时，需要将文本框设置成多行显示，否则文本内容只能在一行中显示，示例代码如下：

Private Sub UserForm_Initialize()With TextBox1.WordWrap = True.MultiLine = True.Text = Space(4) & "VBA(Visual Basic for Application)是" _& "微软公司为了加强Office软件的二次开发能力而附加" _& "于其中的编程语言。VBA的确非常强大，其与VB完全一" _& "致的语法结构，高效控制Office对象模型的能力，令无" _& "数人为之折腰。利用VBA，几乎可以在Office里面做任何" _& "其他程序能做的事情。但是，应该清楚的认识到VBA是依" _& "托其宿主─—Excel（或其他Office组件）而存在的，对" _& "于Excel用户来讲，VBA只不过是锦上添花的东西，切不可" _& "本末倒置，捡了芝麻丢了西瓜，把明明能够利用Excel内置" _& "功能完成的任务，硬是搬到VBA里面去做，以为用代码实现" _& "就是高人一头的表现。其实，真正的高手，会尽量发挥" _& "Excel自身的威力，不到万不得已的时候是不会去<Alt+F11>的。"End With
End Sub

代码解析：
窗体的Initialize事件过程，在窗体显示时将文本框设置成多行显示文本。
第3行代码设置文本框的WordWrap属性。WordWrap属性指定一个控件的内容在行末是否自动换行，语法如下：

object.WordWrap [= Boolean]

参数object是必需的，一个有效的对象。
参数Boolean是可选的，控件是否扩展以适应文本的大小，设置为True，文本换行，设置为False，文本不换行。
第4行代码设置文本框的MultiLine属性。MultiLine属性规定控件能否接受和显示多行文本，语法如下：

object.MultiLine [= Boolean]

参数object是必需的，一个有效的对象。
参数Boolean是可选的，控件是否支持多行文本，设置为True，以多行显示文本，设置为False，不多行显示文本。如果将多行文本框的MultiLine属性设置为False，则文本框的所有字符都将合并为一行，包括非打印字符（如，回车和换行）。
对于既支持WordWrap属性又支持MultiLine属性的控件，当MultiLine属性为False时，WordWrap属性被忽略。
运行窗体，文本框显示如图 105 1所示。

图 105 1 文本框自动换行

106. 多个文本框数据相加

在技巧102 中，我们在TextBox1、TextBox2中输入完数据后，利用文本框的Change事件使TextBox3显示其两者相乘的金额，但是如果窗体中有多个文本框，需要在每一个文本框的Change事件中写上相同的重复代码，因此使用类模块可以简化代码。
在附件的窗体有七个文本框，其中六个用来输入数据，一个用来显示其他六个文本框相加后的合计数，首先打开VBE，插入一个类模块建立一个类，类模块的名字就是类的名字修改为“cmds”，在类模块中输入下面的代码：
Public WithEvents cmd As MSForms.TextBox
代码解析：
使用Public语句声明变量cmd是用来响应由TextBox对象触发的事件的对象变量。
在窗体的Initialize事件中写入下面的代码：

Dim col As New Collection
Private Sub UserForm_Initialize()Dim i As IntegerDim myc As cmdsFor i = 1 To 6Set myc = New cmdsSet myc.cmd = Me.Controls("TextBox" & i)col.Add mycNextSet myc = Nothing
End Sub

代码解析：
第1行代码在模块顶部声明变量col的类型为集合。
第5行到第9行代码，将窗体中的六个文本框赋给col集合。
（关于类模块请参阅论坛中有关的资料。）
在类模块中写入下面的代码：

Private Sub cmd_Change()Dim i As IntegerDim Dval As DoubleFor i = 1 To 6Dval = Dval + Val(UserForm1.Controls("TextBox" & i))UserForm1.TextBox7.Value = DvalNext
End Sub

代码解析：
窗体中的六个文本框统一的Change事件，当任何一个文本框中的数据发生变化时，所有文本框相加的合计数显示在最后一个文本框中。
运行窗体在文本框中输入数据结果如图 106 1所示。

图 106 1 多个文本框数据相加

107. 控件跟随活动单元格

在工作表中使用控件时一般都把控件放在工作表的上部，如果工作表中数据较多，当页面滚动到工作表下面的区域时，控件会离开当前可视区域，这时操作起来很不方便。解决方法除了冻结工作表的第一行放置控件的外，还可以使控件出现在选定的单元格位置，如下面的代码所示。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)With Me.CommandButton1.Top = Target.Top.Left = Target.Left + Target.WidthEnd With
End Sub

代码解析：
工作表的SelectionChange事件，使工作表中的按钮控件出现在选定单元格的右边。
第3行代码，设置按钮的Top属性等于选定单元格的Top属性。Top属性设置对象顶端到第一行顶端的距离。
第4行代码，设置按钮的Left属性等于选定单元格的Left属性加上选定单元格的宽度，即按钮出现在选定单元格的右边。Left属性设置对象左边界至 A 列左边界的距离。
当单击工作表区域的任一单元格，按钮出现在单元格的右边，如图 107 1所示。

图 107 1 控件跟随活动单元格

108. 高亮显示按钮

为了达到当鼠标掠过按钮时以高亮和凸起显示按钮的效果，可以在窗体和按钮的MouseMove事件中进行模拟，如下面的代码所示。

Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)With Me.CommandButton1.BackColor = &HFFFF00.Width = 62.Height = 62.Top = 69.Left = 31End With
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)With Me.CommandButton1.BackColor = Me.BackColor.Width = 60.Height = 60.Top = 70.Left = 32End With
End Sub

代码解析：
窗体和按钮的MouseMove事件过程，以高亮和凸起显示按钮。
当用户在窗体中移动鼠标时，分别在窗体和按钮的MouseMove事件设置按钮的BackColor属性值，指定按钮的背景色，当鼠标移动到按钮时以高亮显示，当鼠标移动到窗体时恢复原来的设置。接下来分别设置按钮不同的Width属性、Height属性、Top属性和Left属性值，以模拟按钮凸起的效果。
运行窗体，当鼠标掠过按钮时效果如图 108 1所示。

图 108 1 高亮和凸起显示按钮

109. 组合框和列表框添加列表项的方法

组合框和列表框是Excel中最常用的控件，可以用来显示工作表中的数据。为组合框和列表框添加列表项的方法有多种，下面以列表框为例演示添加列表项的方法。
109-1 使用RowSource属性添加列表项
使用RowSource属性将列表框直接与工作表上的一个单元格区域相链接，如下面的代码所示。

Private Sub UserForm_Initialize()Dim iRow As IntegeriRow = Sheet1.Range("A65536").End(xlUp).RowMe.ListBox1.RowSource = "sheet1!a1:a" & iRow
End Sub

代码解析：
在窗体初始化时使用RowSource属性为列表框添加列表项。
RowSource属性的语法如下：

object.RowSource [= String]

参数object是必需的，一个有效的对象。
参数String是可选的，组合框或列表框列表的来源。
RowSource属性也可以使用单元格地址，第4行代码可以改成下面的代码：
Me.ListBox1.RowSource = Sheet1.Range(“A1:A” & iRow).Address(External:=True)
需要注意的是，如果RowSource属性指定的工作表区域不是活动工作表的话，Address属性的External参数是不可缺的，设置为True表示是外部引用，如果缺省此参数或为False，将不能为列表框添加列表项。
RowSource属性还可以使用命名的单元格区域，如果已把工作表区域命名为“城市”，第4行代码可以改成下面的代码：
Me.ListBox1.RowSource = “城市”
对于工作表中的列表框控件或使用窗体添加的列表框控件不能使用RowSource属性，需要使用ListFillRange属性指定填充列表框的工作表区域，如下面的代码所示。

Sub ListFillRange()Dim iRow As IntegeriRow = Sheet1.Range("A65536").End(xlUp).RowSheet2.ListBox1.ListFillRange = "Sheet1!a1:a" & iRowSheet2.Shapes("列表框").ControlFormat.ListFillRange = "Sheet1!a1:a" & iRow
End Sub

代码解析：
ListFillRange过程为工作表中的列表框的填充区域，ListFillRange属性用于指定填充列表框的工作表区域。
第4行代码对于使用窗体添加的列表框控件需要使用ControlFormat属性来返回窗体控件以后才能设置其ListFillRange属性。
109-2 使用List属性添加列表项
使用List属性为列表框添加列表项，如下面的代码所示。

Private Sub UserForm_Initialize()Dim Arr As VariantDim iRow As IntegeriRow = Sheet1.Range("A65536").End(xlUp).RowArr = Sheet1.Range("A1:A" & iRow)Me.ListBox1.List = Arr
End Sub

代码解析：
在窗体初始化时使用List属性为列表框添加列表项。
List属性的语法如下：

object.List( row, column ) [= Variant]

参数object是必需的，一个有效对象。
参数row是必需的，取值范围为 0 到列表条目数减 1 之间的数值。
参数column是必需的，取值范围为 0 到总列数减 1 之间的数值。
参数Variant是可选的，列表框中指定条目的内容。
第6行代码，使用List属性把数组复制到列表框控件上。
除了使用数组外，List属性还可以使用命名的单元格区域，如果已把工作表区域命名为“城市”，可以改成下面的代码：

Private Sub UserForm_Initialize()Me.ComboBox1.List = Range("城市").Value
End Sub

对于工作表中使用窗体添加的列表框控件使用List属性添加列表项，如下面的代码所示。

Sub List()Dim Arr As VariantDim iRow As IntegerDim myObj As ObjectiRow = Sheet1.Range("A65536").End(xlUp).RowArr = Sheet1.Range("A1:A" & iRow)Set myObj = Sheet2.Shapes("列表框").ControlFormatmyObj.List = Arr
End Sub

代码解析：
List过程设置列表框的List性，用于指定填充列表框的工作表区域。
109-3 使用AddItem方法添加列表项
使用AddItem方法添加列表项，对于单列的列表框，在列表中添加一项。对于多列的列表框，在列表中添加一行，如下面的代码所示。

Private Sub UserForm_Initialize()Dim iRow As IntegerDim i As IntegeriRow = Sheet1.Range("A65536").End(xlUp).RowFor i = 1 To iRowMe.ListBox1.AddItem (Sheet1.Cells(i, 1))Next
End Sub

代码解析：
在窗体初始化时使用AddItem方法为列表框添加列表项。
AddItem方法的语法如下：

object.AddItem [ item [, varIndex]]

参数object是必需的，一个有效的对象。
参数item是可选的，指定要添加的项或行。第一个项或行的编号为 0；第二个项或行的编号为 1，依此类推。
参数varIndex是可选的，指定新的项或行在对象中的位置。
如果提供一个有效的varIndex的值，AddItem方法就把项或行放在列表中的那个位置。如果忽略 varIndex，此方法就把项或行添加在列表的末尾。对于多列列表框或者组合框，AddItem 方法插入一个完整的行，为控件的每一列都插入一项。为了给第一列后面的项赋值，可用List或Column属性来规定项的行和列。
对于工作表中使用窗体添加的列表框控件使用AddItem方法添加列表项，如下面的代码所示。

Sub AddItem()Dim iRow As IntegerDim i As IntegeriRow = Sheet1.Range("A65536").End(xlUp).RowWith Sheet2.Shapes("列表框").ControlFormat.RemoveAllItemsFor i = 1 To iRow.AddItem Sheet1.Cells(i, 1)NextEnd With
End Sub

代码解析：
AddItem过程设置使用AddItem方法添加为工作表中使用窗体控件添加的列表框添加列表项。
其中第5行代码使用ControlFormat属性来返回窗体控件，第6行代码使用RemoveAllItems方法删除窗体控件中的列表框的所有数据项，如果控件是ActiveX 列表框则需要使用Clear方法。

110. 去除列表框数据源的重复值和空格

列表框的数据源引用工作表的数据时，如果工作表数据有重复值和空格，列表框也会出现重复值和空格，如图 110 1所示。

图 110 1 列表框中的重复值和空格
为了在窗体显示时去除列表框的重复值和空格，可以使用Add方法，如下面的代码所示。

Private Sub UserForm_Initialize()On Error Resume NextDim Col As New CollectionDim rng As Range, arrDim i As IntegerFor Each rng In Range("A1:A" & [a65536].End(xlUp).Row)If Trim(rng) <> "" ThenCol.Add rng, key:=CStr(rng)End IfNextReDim arr(1 To Col.Count)For i = 1 To Col.Countarr(i) = Col(i)NextMe.ListBox1.List = arr
End Sub

代码解析：
窗体的初始化事件，去除列表框引用工作表数据中的重复值和空格。
第2行代码，错误处理语句，忽略错误。
第3行到第5行代码，声明变量类型。
第6行到第9行代码代码，在列表框引用的工作表数据中循环，把工作表数据源中的空格去除后使用Add方法添加到变量Col中。Add方法添加一个成员到Collection 对象，语法如下：

object.Add item, key, before, after

参数object是必需的，一个有效的对象。
参数Item是必需的，任意类型的表达式，指定要添加到集合中的成员。
参数Key是可选的，唯一字符串表达式，指定可以使用的键字符串，代替位置索引来访问集合中的成员。
如果指定的key和集合中现有成员的key发生重复，则会导致错误发生。所以在第2行代码中使用错误处理语句，忽略错误，继续执行下一句代码，这样就将数据源中的重复值去除。
参数before是可选的，指定集合中的相对位置。在集合中将添加的成员放置在before参数识别的成员之前。如果参数是数值表达式，则before必须是介于 1 和集合Count属性值之间的值。如果参数是字符串表达式，则当添加一个被引用的成员到集合时，before 必须对应于指定的key值。可以指定before位置或after位置，但不能同时指定这两个位置。
参数after是可选的，指定集合中的相对位置。在集合中将添加的成员放置在After参数识别的成员之后。如果参数是数值表达式，则after必须是介于 1 和集合Count属性值之间的值；如果参数是字符串表达式，则当添加一个被引用的成员到集合时，after 必须对应于指定的key值。可以指定before位置或after位置，但不能同时指定这两个位置。
第10行到第14行代码，重新定义数组arr大小，把Col中数据赋给数组。
第15行代码，把数组arr复制到列表框中。
运行窗体，窗体中的列表框引用去除重复值和空格后的工作表数据，如图 110 2所示。

图 110 2 去除重复值和空格的列表框

111. 移动列表框条目

将列表框中的条目进行上下移动，如下面的代码所示。

Dim Intlist As Integer
Dim Strlist As String
Private Sub CommandButton1_Click() With Me.ListBox1Intlist = .ListIndexSelect Case IntlistCase -1MsgBox "请选择一行后再移动!"Case 0MsgBox "已经是最上一行了!"Case Is > 0Strlist = .List(Intlist).List(Intlist) = .List(Intlist - 1).List(Intlist - 1) = Strlist.ListIndex = Intlist - 1End SelectEnd With
End Sub
Private Sub CommandButton2_Click() With ListBox1Intlist = .ListIndexSelect Case IntlistCase -1MsgBox "请选择一行后再移动!"Case .ListCount - 1MsgBox "已经是最下一行了!"Case Is < .ListCount - 1Strlist = .List(Intlist).List(Intlist) = .List(Intlist + 1).List(Intlist + 1) = Strlist.ListIndex = Intlist + 1End SelectEnd With
End Sub

代码解析：
第1、2行代码在模块顶部声明两个变量分别用于保存列表框当前选中行的索引和内容。
第3行到第18行代码，将列表框当前选中行的内容上移一行的代码。其中第5行代码使用变量Intlist保存列表框当前选中行的索引号，第6行代码判断索引号,，第7、8行代码如果变量Intlist值为-1 ，说明当前没有选中的行，显示一个消息框进行提示。第9、10行代码变量Intlist值为0 ，说明当前选中的行已是第一行了。
列表框的ListIndex属性指定当前选中的列表框或组合框条目，语法如下：

object.ListIndex [= Variant]

参数object是必需的，一个有效的对象。
参数Variant是可选的，控件中当前被选的条目。
第11行到第15行代码将当前选中的行向下移动一行，其中第12行代码将当前选中的行的内容赋给变量Strlist，第13行代码将当前选中行的内容更改为下面一行的内容，第14行代码将当前选中行的下面一行的内容更改为变量Strlist保存的内容，第15行代码将选中行向下移动一行，这样就将当前选中的行向下移动了一行。
第19行到第34行代码将当前选中的行向上移动一行。
将移动后的列表框条目保存到工作表中的代码如下：

Private Sub CommandButton3_Click()Dim i As IntegerFor i = 1 To ListBox1.ListCountSheet1.Cells(i + 1, 1) = ListBox1.List(i - 1)Next
End Sub

代码解析：
窗体中“保存”按钮的单击过程，将移动后的列表框条目保存到工作表。
第3行到第5行代码使用For…Next 语句循环遍历列表框所有条目，将List属性返回的列表框的列表条目写入到工作表中。List属性返回或设置列表框或组合框的列表条目数，语法请参阅技巧109-2。
运行窗体效果如所示。

图 111 1 移动列表框条目

112. 允许多项选择的列表框

一般情况下在显示的列表框中用户只能选择一个列表项，而经过简单的设置，列表框条目前可以显示选项按钮，允许进行多项选择，如下面的代码所示。

Private Sub UserForm_Initialize()Dim arr As Variantarr = Array("经理室", "办公室", "生技科", "财务科", "营业部", "制水车间", "污水厂", "安装公司", "其他")With Me.ListBox1.List = arr.ListStyle = 1.MultiSelect = 1End With
End Sub

代码解析：
窗体的Initialize事件过程，在窗体初始化时对列表框进行设置。
其中第5行代码使用List属性为列表框添加列表项，请参阅技巧109-2。
第6行代码将列表框的ListStyle属性设置为1（fmListStyleOption），显示用于多重选择列表的复选框，ListStyle属性规定列表框或组合框中的列表的外观，语法如下：

object.ListStyle [= fmListStyle]

参数object是必需的，一个有效的对象。
参数fmListStyle是可选的，列表的可视风格，设置值如表格 112 1所示。
常量 值 说明
fmListStylePlain 0 外观与常规的列表框相似，条目的背景为高亮
fmListStyleOption 1 显示选项按钮，或显示用于多重选择列表的复选框（默认）。当用户选定组中的条目时，与该条目相关的选项按钮即被选中，而该组其他条目的选项按钮则被取消选择
表格 112 1 fmListStyle设置值
ListStyle 属性可用来改变列表框或组合框的可视外观。通过一种不同于 fmListStylePlain 的设置，可以将任意控件的内容作为一组单独项目演示，每个项目都包含一个可视记号用以表示它是否被选中。
如果控件支持单一选择（MultiSelect属性被设置为mMultiSelectSingle），则可按下组中的一个按钮。如果控件支持多重选择，则可以按下组中两个或更多的按钮。
第7行代码将MultiSelect属性设置为1（fmMultiSelectMulti），允许列表框进行多项选择，MultiSelect属性表示对象是否允许多项选择，语法如下：

object.MultiSelect [= fmMultiSelect]

参数object是必需的，一个有效的对象。
参数fmMultiSelect是可选的，控件所用的选择方式，设置值如表格 112 2所示。

常量	值	说明
fmMultiSelectSingle	0	只可选择一个条目（默认）
fmMultiSelectMulti	1	按空格键或单击鼠标以选定列表中一个条目或取消选定
fmMultiSelectExtended	2	按 Shift 并单击鼠标，或按 Shift 的同时按一个方向键，将所选条目由前一项扩展到当前项。按 Ctrl 的同时单击鼠标可选定或取消选定

经过以上设置，列表框显示时可以进行多项选择并且条目前都有一个选项按钮用以表示它是否被选中，如图 112 1所示。

图 112 1 允许多项选择的列表框
如果将列表框的ListStyle属性设置为0则与常规的列表框相似。
如果将列表框的MultiSelect属性设置0则列表框只能进行单项选择，如图 112 2所示。

图 112 2 允许单项选择的列表框
通过列表框的Selected属性值可以判断列表框中条目的选定状态，如下面的代码所示。

Private Sub CommandButton1_Click()Dim i As IntegerDim s As StringFor i = 0 To ListBox1.ListCount - 1If ListBox1.Selected(i) = True Thens = s & ListBox1.List(i) & Chr(13)End IfNextIf s <> "" ThenMsgBox "你选择了：" & Chr(13) & sElseMsgBox "请最少选择一个部门!"End If
End Sub

代码解析：
按钮的单击过程，将列表框中选中的条目使用消息框显示出来。
第4行到第8行代码使用For…Next 语句循环遍历列表框所有条目，通过返回的Selected属性值判断列表框中条目的选定状态，如果处于选中状态，第6行代码将列表框选中条目的值赋给字符串变量s。
Selected属性判断列表框中条目的选定状态，语法如下：

object.Selected( index ) [= Boolean]

• 参数object：必需的，一个有效的对象。
• 参数index：必需的，整数，取值范围是0到列表中的条目数减1之间的数值。
• 参数Boolean：必需的，判断一个条目是否被选中。
  第9行到第13行代码使用消息框显示列表框中选中的条目。
  运行窗体结果如图 112 3所示。

图 112 3 允许多项选择的列表框

113. 多列组合框和列表框的设置

113.1 多列组合框和列表框添加列表项

如果组合框和列表框是多列的话，除了使用技巧109 的方法外，还需要设置控件的其他属性，如下面的代码所示。

Private Sub UserForm_Initialize()Dim iRow As IntegerDim Arr As VariantiRow = Sheet1.Range("A65536").End(xlUp).RowArr = Sheet1.Range("A1:G" & iRow)With Me.ListBox1.ColumnCount = 7.ColumnWidths = "45,45,45,45,45,30,45".BoundColumn = 1.Column = Application.WorksheetFunction.Transpose(Arr)End With
End Sub

代码解析：
在窗体初始化时为多列列表框添加列表项。
第4行代码，设置列表框显示的列数。ColumnCount 属性指定列表框或组合框的显示列数，语法如下：

object.ColumnCount [= Long]

参数object是必需的，一个有效的对象。
参数Long是可选的，指定需显示的列数。
如果将ColumnCount设为 -1，将显示所有列。
第8行代码，设置列表框各列的宽度。ColumnWidths 属性指定多列的组合框或列表框中的各列的宽度，语法如下：

object.ColumnWidths [= String]

参数object是必需的，一个有效的对象。
参数String是可选的，以磅为单位设置列的宽度。
如将ColumnWidths 属性设为 -1 或空，则将控件宽度等分，给予列表中的各列。设为 0 则隐藏该列，大于 0 的数值则是该列的精确宽度值。若要指定另一种不同的度量单位，设置时必须包括该度量单位。
第9行代码，设置多列列表框中的第一列为数据的来源。BoundColumn 属性标识多列组合框或列表框中的数据的来源，语法如下：

object.BoundColumn [= Variant]

参数object是必需的，一个有效的对象。
参数Variant是可选的，标识选择 BoundColumn 属性值的方法，设置值如表格 113 1所示：
值 说明
0 将 ListIndex 属性的值赋予控件。
1 或者大于 1 将指定列中的值赋予控件。当采用此属性时，列从 1 开始计数（默认值）。
表格 113 1 Variant 的设置值
当选择了多列列表框的一行时，BoundColumn 属性标识出将该行的哪一条目作为控件的值存储。BoundColumn属性设为 0，将所选行的行号赋予控件，作为控件的值。如果BoundColumn属性设为1 或者大于 1，则将指定列中的值赋予控件。
第10行代码，设置多列列表框中列表的来源。在设置列表来源时除了可以使用技巧109 所介绍的方法外，还可以使用Column属性指定列表框中的一个或多个条目，Column属性语法如下：

object.Column( column, row ) [= Variant]

参数object是必需的，一个有效对象。
参数column是可选的，取值范围为0到总列数减1之间的数值。
参数row是可选的，取值范围为0到总行数减1之间的数值。
参数Variant是可选的，指定欲加载到列表框的一个值、一列值或一个二维数组。
注意 当从一个二维数组中复制数据时，使用Column属性将转置控件中数组的内容，所以在加载时需使用Transpose函数对数组进行转置。
多列列表框设置完成后效果如图 113 1所示。

图 113 1 多列列表框

113.2 多列列表框写入工作表

在把多列列表框的写入工作表中时，只能把BoundColumn属性所指定列中的值写入工作表中，不能把选中的整行内容写入到工作表中。如果需要把多列列表框中选中行的整行内容写入工作表中，可以使用循环语句将列表框各列的写入工作表，如下面的代码所示。

Private Sub UserForm_Initialize()Dim iRow As IntegeriRow = Sheet2.Range("A65536").End(xlUp).RowWith Me.ListBox1.ColumnCount = 7.ColumnWidths = "45,45,45,45,45,30,45".BoundColumn = 1.ColumnHeads = True.RowSource = Sheet2.Range("A2:G" & iRow).Address(External:=True)End With
End Sub
Private Sub ListBox1_Click()Dim iRow As IntegerDim i As ByteiRow = Sheet1.Range("A65536").End(xlUp).Row + 1For i = 1 To ListBox1.ColumnCountSheet1.Cells(iRow, i) = ListBox1.Column(i - 1)Next
End Sub

代码解析：
第1行到第11行代码窗体的Initialize事件过程，在窗体初始化时为多列列表框添加列表项，请参阅技巧113-1。
第8行代码，设置多列列表框中的第一行为列标题行。ColumnHeads 属性显示列表框、组合框及接受列题注的对象中的列标题行，语法如下：

object.ColumnHeads [= Boolean]

参数object是必需的，一个有效的对象。
参数Boolean是可选的，指定是否显示列标题。
将ColumnHeads 属性设置为True，多列列表框的第一行显示为列标题，默认值为False，不显示列标题。
需要注意的是，当数据项中的第一行作为列标题时，则不可选中该行。
第9行代码，使用RowSource属性设置多列列表框中列表的来源。关于RowSource属性请参阅技巧109-1。
注意 如果已将多列列表框中列表项来源的第一行设置为列标题，在设置RowSource属性时应从列表项来源的第二行开始设置。
第12行到第19行代码列表框的Click事件，单击多列列表框时把选中行的整行内容写入工作表中。其中第17行代码，使用循环语句将多列列表框选中行的各列的值写入工作表对应的单元格中。关于Column属性请参阅技巧113-1，在本例中没有指定row参数，所以是把当前选中行的内容写入工作表。
运行窗体后，单击列表框将选中的整行内容写入工作表中，如图 113 2所示。

图 113 2 多列列表框选中的整行内容写入工作表

114. 输入时逐步提示信息

用户在录入数据时，比如在工作表中输入产品名称，除了希望有所有产品名称的下拉列表供选择外，更希望能逐步给出提示信息。比如在输入一两个字符后把符合条件的数据筛选出来供选择，最好是中英文、拼音首字母、大小写能混合查询，如输入“LJ”或“六角”后所有以“六角”开头的产品名称都筛选到列表中供选择，这将大大提高录入速度和正确率。
为了达到这一目的，首先在工作簿需要有如图 114 1所示的基础数据表。

图 114 1 基础数据表
基础数据表中A列保存不重复的产品名称，为了能用中英文、拼音首字母、大小写混合查询，要把产品名称转换成小写的拼音首字母保存在B列。
步骤1：在VBE窗口单击菜单“插入”→“模块”，在代码窗口写入下面的代码。

Public Function LChin(Str As String) As VariantOn Error Resume NextStr = StrConv(Str, vbNarrow)If Asc(Str) > 0 Or Err.Number = 1004 Then LChin = ""LChin = WorksheetFunction.VLookup(Str, [{"吖","a";"八","b";"嚓","c";"咑","d";"鵽","e";"发","f";"猤","g";"铪","h";"夻","j";"咔","k";"垃","l";"嘸","m";"旀","n";"噢","o";"妑","p";"七","q";"囕","r";"仨","s";"他","t";"屲","w";"夕","x";"丫","y";"帀","z"}], 2)
End Function

代码解析：
自定义LChin函数，该函数把中文字符转换为拼音首字母。
步骤2：在VBE窗口双击Sheet2表，在代码窗口写入下面的代码。

Private Sub Worksheet_Change(ByVal Target As Range)Dim i As IntegerDim myStr As StringWith TargetIf .Column <> 1 Or .Count > 1 Then Exit SubIf WorksheetFunction.CountIf(Sheet2.Range("A:A"), .Value) > 1 Then.Value = ""MsgBox "不能输入重复的产品名称!", 64Exit SubEnd IfFor i = 1 To Len(.Value)If Asc(Mid$(.Value, i, 1)) > 255 Or Asc(Mid$(.Value, i, 1)) < 0 ThenmyStr = myStr & LChin(Mid$(.Value, i, 1))ElsemyStr = myStr & LCase(Mid$(.Value, i, 1))End IfNext.Offset(, 1).Value = myStrEnd WithEnd Sub

代码解析：
工作表的Change事件，当A列输入不重复的产品名称后，转换成小写的字母保存在B列的单元格中，便于以后的查询。
第11行代码，设置事件触发的条件，只有在A列输入产品名称后才触发Change事件。
第12行到第16行代码，使用工作表CountIf函数检查输入的产品名称是否重复。
第17行到第23行代码，字符的转换过程。首先检查是否是中文字符，如果是使用自定义函数LChin转换成小写拼音首字母。如果是大写的英文字母使用LCase函数转换成小写字母。
第24行代码，将转换后的字符保存到B列。
步骤3：基础数据表完成后，在工作表“录入表”中添加一个文本框控件和一个列表框控件。在VBE窗口中双击Sheet1表，写入下面的代码。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)Dim i As IntegerIf Target.Count = 1 ThenIf Target.Column = 1 And Target.Row > 1 ThenWith Me.TextBox1.Visible = True.Top = Target.Top.Left = Target.Left.Width = Target.Width.Height = Target.Height.ActivateEnd WithWith Me.ListBox1.Visible = True.Top = Target.Top.Left = Target.Left + Target.Width.Width = Target.Width.Height = Target.Height * 5For i = 2 To Sheet2.Range("A65536").End(xlUp).Row.AddItem Sheet2.Cells(i, 1).ValueNextEnd WithElseMe.ListBox1.ClearMe.TextBox1 = ""Me.ListBox1.Visible = FalseMe.TextBox1.Visible = FalseEnd IfEnd If
End Sub

代码解析：
工作表的SelectionChange事件，当用户选定工作表A列第2行以下的单个单元格时，设置文本框和列表框的Visible为True，使它们成为可见的，并设置其外观，同时给列表框加载列表项。当用户选定其他列的单元格时隐藏文本框和列表框控件。
步骤4：在设计模式下双击文本框，在代码窗口写入下面的代码。

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)Dim i As IntegerDim Language As BooleanDim myStr As StringMe.ListBox1.ClearWith Me.TextBox1For i = 1 To Len(.Value)If Asc(Mid$(.Value, i, 1)) > 255 Or Asc(Mid$(.Value, i, 1)) < 0 ThenLanguage = TruemyStr = myStr & Mid$(.Value, i, 1)ElsemyStr = myStr & LCase(Mid$(.Value, i, 1))End IfNextEnd WithWith Sheet2For i = 2 To .Range("A65536").End(xlUp).RowIf Language = True ThenIf Left(.Cells(i, 1).Value, Len(myStr)) = myStr ThenMe.ListBox1.AddItem .Cells(i, 1).ValueEnd IfElseIf Left(.Cells(i, 2).Value, Len(myStr)) = myStr ThenMe.ListBox1.AddItem .Cells(i, 1).ValueEnd IfEnd IfNextEnd With
End Sub

代码解析：
文本框的KeyUp事件，在文本框输入查询条件时筛选符合条件的数据加载到列表框。
第3行代码，声明变量Language为Boolean数据类型，在下面的代码中使用Language的值判断输入的是否为中文。
第5行代码，使用Clear方法删除列表框所有的列表项，语法如下：

object.Clear

参数object是必需的，一个有效的对象。
注意 如果列表框绑定了数据，Clear方法将会失败。
第6行到第15行代码，判断文本框输入的是否为中文字符。如果是中文字符，将变量Language赋值为True，并把文本框中的字符赋给变量myStr。如果是英文字符则转换成小写字母后赋变量myStr。
第16行到第29行代码，如果变量Language的值为True，在基础数据表的A列中使用Left函数查找与文本框字符相符的单元格并加载到列表框，否则就在B列查找。
步骤5：在设计模式下双击文本框，在代码窗口写入下面的代码。

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)If KeyCode = vbKeyReturn ThenSheet1.ListBox1.ActivateEnd If
End Sub

代码解析：
文本框的KeyDown事件，当用户在文本框中输入完成，列表框中已显示所需的内容后按回车键后选择列表框。
步骤6：在设计模式下双击列表框，在代码窗口写入下面的代码

Private Sub ListBox1_GotFocus()On Error Resume NextListBox1.ListIndex = 0
End Sub

代码解析：
列表框的GotFocus事件，当用户在文本框中输入完成按回车键后，选定列表框中第1个条目，方便用户进行下一步操作。

Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)If KeyCode = vbKeyReturn ThenActiveCell.Value = ListBox1.ValueMe.ListBox1.ClearMe.TextBox1 = ""Me.ListBox1.Visible = FalseMe.TextBox1.Visible = FalseEnd If
End Sub

代码解析：
列表框的KeyDown事件，当用户在列表框中按下回车后将列表框选中的条目写入到活动工作表的单元格中，同时清空文本框和列表框内容后隐藏，准备下一次录入。

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveCell.Value = ListBox1.ValueMe.ListBox1.ClearMe.TextBox1 = ""Me.ListBox1.Visible = FalseMe.TextBox1.Visible = False
End Sub

代码解析：
列表框的DblClick事件，当用户双击列表框的列表项时，把列表框数据赋给活动单元格，同时清空文本框和列表框内容后隐藏，准备下一次录入。
以上设置完成后，在“录入”工作表的A列选定单元格后，显示一个文本框和一个列表框，在文本框中输入查询条件后列表框显示符合查询条件的所有内容供用户选择，如图 114 2所示。

图 114 2 输入时逐步提示信息

115. 二级组合框

在使用多个组合框输入数据时，往往希望后一个组合框中的条目能根据前一个组合框的内容有所不同，如示例中第二个选择城市的组合框根据第一个选择省份的组合框所选择的不同省份加载不同的县市名称，示例代码如下：

Private Sub UserForm_Initialize()Dim col As New CollectionDim arr As VariantDim rng As RangeDim i As IntegerOn Error Resume NextFor Each rng In Range("A2:A" & Sheet1.Range("A65536").End(xlUp).Row)If rng <> "" Then col.Add rng, CStr(rng)NextReDim arr(1 To col.Count)For i = 1 To col.Countarr(i) = col(i)NextComboBox1.List = arrComboBox1.ListIndex = 0CommandButton1.Accelerator = "D"
End Sub
Private Sub ComboBox1_Change()Dim myAddress As StringDim rng As RangeDim mymsg As IntegerComboBox2.ClearWith Sheet1.Range("A:A")Set rng = .Find(What:=ComboBox1.Text)If Not rng Is Nothing ThenmyAddress = rng.AddressDoComboBox2.AddItem rng.Offset(, 1)Set rng = .FindNext(rng)Loop While Not rng Is Nothing And rng.Address <> myAddressEnd IfEnd WithComboBox2.ListIndex = 0
End Sub

代码解析：
第1行到第17行代码窗体的Initialize事件过程，在窗体显示时将工作表A列中的省份名称去除重复后加载到组合框中。
其中第7行到第13行代码把工作表A列中的省份名称使用Add方法去除重复后加载到组合框中，应用于Collection 对象的Add方法添加一个成员对象，请参阅技巧110 。
第15行代码设置组合框的ListIndex属性为0，选中组合框的第一行条目。ListIndex属性指定当前选中的列表框或组合框条目，语法如下：

object.ListIndex [= Variant]

参数Variant是可选的，控件中当前被选的条目。
ListIndex 属性包含列表中被选行的索引，取值范围为 -1 到列表总行数减 1（即ListCount - 1）之间的数值。当用户没有选中行时，ListIndex 返回 -1。列表中第一行的 ListIndex值是0，第二行的ListIndex 值是1，依此类推。
第16行代码设置窗体中按钮的Accelerator属性值。Accelerator属性设置或检索控件的加速键，语法如下：

object.Accelerator [= String]

参数String是可选的，用作加速键的字符。
先按住 Alt 再紧接着按加速键，会将焦点定位到该对象上，并初始化与该对象关联的一个或多个事件，也就是说窗体显示后按Alt+D组合键将会执行“关闭”按钮中的代码关闭窗体。
第18行到第34行代码ComboBox1的Change事件过程，使用Find方法将所有属于ComboBox1所选择的省份的县市加载到ComboBox2中。关于Find方法请参阅技巧5-1。
窗体运行后效果如图 115 1所示。

图 115 1 二级组合框

116. 使用DTP控件输入日期

在工作表中输入日期可以使用日期时间控件（Microsoft Date and Time Picker Control 6.0，简称DTP控件）。
在工作表中单击菜单“视图”→“工具栏”→“控件工具箱”，选择“其他控件”中的DTP控件如图 116 1所示，在工作表中添加一个DTP控件。

图 116 1 选择DTP控件
在设计模式下双击DTP控件写入下面的代码：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)With Me.DTPicker1If Target.Count = 1 And Target.Column = 2 And (Not Target.Row = 1) Or Target.MergeCells Then.Visible = True.Top = Selection.Top.Left = Selection.Left.Height = Selection.Height.Width = Selection.WidthIf Target.Cells(1, 1) <> "" Then.Value = Target.Cells(1, 1).ValueElse.Value = DateEnd IfElse.Visible = FalseEnd IfEnd With
End Sub
Private Sub DTPicker1_CloseUp()ActiveCell.Value = Me.DTPicker1.ValueMe.DTPicker1.Visible = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)If Target.Count = 1 And Target.Column = 2 Or Target.MergeCells ThenIf Target.Cells(1, 1).Value = "" ThenDTPicker1.Visible = FalseEnd IfEnd If
End Sub

代码解析：
第1行到第18行代码工作表的SelectionChange事件，当选择工作表的B列第2行以下的单个单元格时显示日期控件供用户选择日期。
其中第3行代码设置显示日期控件的触发条件。只有当用户选择B列第2行以下单元格且只能选择单个单元格时才显示日期控件，因为本例B列中存在合并单元格，所以需要加上Or Target.MergeCells这个条件，否则单击合并单元格不显示日期控件。
第4行到第8行代码显示日期控件并设置日期控件的大小等于所选单元格的大小。
第9行到第13行代码，如果单元格已经输入了日期，将单元格中的日期赋给日期控件，否则将当前日期赋给日期控件。因为本例B列中存在合并单元格，而合并区域的值在该区域左上角的单元格中指定，所以用Target.Cells(1, 1) 指定合并单元格的值，否则代码会出错。
第15行代码如果选择的是其他列则隐藏日期控件。
第19行到第22行代码日期控件的CloseUp事件，将日期控件的值赋给活动单元格后隐藏日期控件。
第23行到第29行代码工作表的Change事件，如果删除了B列单元格的日期则隐藏日期控件。
当用户选择B列单元格时效果如图 116 2所示。

图 116 2 使用DTP控件输入日期

117. 使用RefEdit控件选择区域

在技巧76-2中介绍了如何使用InputBox方法获得所选单元格区域的地址，而使用RefEdit控件获得单元格区域的地址比使用InputBox方法更加方便，可以单击RefEdit控件中的按钮以折叠用户窗体，选定区域后再单击按钮展开用户窗体，示例代码如下：

Private Sub CommandButton1_Click()Dim Rng As RangeOn Error GoTo lineSet Rng = Range(RefEdit1.Value)Rng.Interior.ColorIndex = 15Unload UserForm1Exit Sub
line:MsgBox "你选择的是非单元格区域!"
End Sub

代码解析：
用户窗体中按钮的单击事件过程，改变用户使用RefEdit控件所选择的单元格区域内部的颜色。
第3行代码，错误处理语句。因为如果用户输入或选定了错误的单元格区域地址，将显示一错误信息，如图 117 1所示，所以必需使用On Error GoTo语句来绕过错误。

图 117 1 提示运行错误
第4行代码，使用Set语句将用户选择的单元格区域赋给变量rng。
第5行代码，改变用户所选单元格区域内部的颜色。
注意 不能在无模式用户窗体中使用RefEdit控件。
窗体运行后，当用户在工作表中选择一个单元格区域后改变所选单元格区域内部的颜色，如图 117 2所示。

图 117 2 使用RefEdit控件获得区域地址

118. 如何注册控件

Excel文件中如果有ActiveX控件如日期时间控件（Microsoft Date and Time Picker Control 6.0，简称DTP控件），在有些电脑上运行时会出现“无法装载这个对象，因为它不适于这台计算机”的提示，如图 118 1所示。文件中的控件丢失，无法正常使用。

图 118 1 无法装载对象提示
这是因为DTP控件没有注册引起的，解决办法是在能运行该控件的电脑中复制DTP控件的文件到目标电脑中进行注册。在VBE窗口中右键单击“工具箱”，选择“附加控件”，在“附加控件”对话框中选择DTP控件，对话框底部会显示控件的名称和文件所在的路径，如图 118 2所示。

图 118 2 OCX文件名称和路径
DTP控件的文件名为MSCOMCT2.OCX，在C盘的Windows\system32文件夹中，把该文件复制到目标电脑C盘的Windows\system32文件夹中，单击“开始”→“运行”，在“运行”对话框中键入“regsvr32 C:\Windows\system32\MSCOMCT2.OCX”，注册成功后会出现如图 118 3所示的对话框，DTP控件即能正常使用。

图 118 3 注册成功提示
在Excel中可以使用程序代码进行自动注册，代码如下：

Sub regsvrs()Dim SouFile As StringDim DesFile As StringOn Error Resume NextSouFile = ThisWorkbook.Path & "\MSCOMCT2.OCX"DesFile = "c:\Windows\system32\MSCOMCT2.OCX"FileCopy SouFile, DesFileShell "regsvr32 /s" & DesFileMsgBox "DTP控件已成功注册，现在可以使用了!"
End Sub

代码解析：
Regsvrs过程将保存在同一目录中的MSCOMCT2.OCX文件复制到电脑的文件夹中，使用Shell函数注册DTP控件。
第4行代码，错误处理语句，用于忽略复制文件时可能出现的错误。因为如果电脑文件夹中已存在MSCOMCT2.OCX文件，使用FileCopy方法复制时会发生错误，如图 118 4所示。

图 118 4 复制文件错误提示
第7行代码，使用FileCopy方法复制MSCOMCT2.OCX文件到电脑中。
FileCopy方法的语法如下：

FileCopy source, destination

参数Source是必需的，字符串表达式，用来表示要被复制的文件名。
参数destination是必需的，字符串表达式，用来指定要复制的目的文件名。
第8行代码，使用Shell函数注册DTP控件。
Shell函数执行一个可执行文件，语法如下：

Shell(pathname[,windowstyle])

参数pathname是必需的，要执行的程序名，以及任何必需的参数或命令行变量，可能还包括目录或文件夹，以及驱动器。
参数windowstyle是可选的，表示在程序运行时窗口的样式。windowstyle参数值如表格所示。

常量	值	描述
vbHide	0	窗口被隐藏，且焦点会移到隐式窗口。常数vbHide在Macintosh平台不可用。
VbNormalFocus	1	窗口具有焦点，且会还原到它原来的大小和位置。
VbMinimizedFocus	2	窗口会以一个具有焦点的图标来显示。
VbMaximizedFocus	3	窗口是一个具有焦点的最大化窗口。
VbNormalNoFocus	4	窗口会被还原到最近使用的大小和位置，而当前活动的窗口仍然保持活动。
VbMinimizedNoFocus	6	窗口会以一个图标来显示。而当前活动的的窗口仍然保持活动。

运行程序前应确保在工作簿同一目录中存在MSCOMCT2.OCX文件。此代码相当于在“运行”对话框中键入“regsvr32 C:\ Windows\system32\MSCOMCT2.OCX”后进行注册，只是在“REGSVR32”后加上了s参数，使注册成功后不会出现如图 118 3所示的对话框。
可以使用程序代码卸载该控件，代码如下：

Sub regsvru()Shell "REGSVR32 /u " & ThisWorkbook.Path & "\MSCOMCT2.OCX"
End Sub

代码解析：
Regsvru过程使用Shell函数注册DTP控件，在pathname参数“REGSVR32”后加上u参数，对DTP控件进行反注册。

119. 遍历控件的方法

如果窗体或工作表中的控件很多，在写代码时，如果是相同的代码，可以使用循环语句遍历控件，无需每个控件都写相同的代码，以减少代码量。

119.1 使用名称中的变量遍历控件

如果控件使用系统缺省名称，如“TextBox1”、“TextBox2”，前面是固定的字符串，后面是序号的，可以使用For…Next 语句循环遍历控件。
对于窗体中的控件，如下面的代码所示。

Private Sub CommandButton1_Click()Dim i As IntegerFor i = 1 To 3Me.Controls("TextBox" & i) = ""Next
End Sub

代码解析：
窗体按钮的单击事件，一次性清空窗体中三个文本框的内容。
###第4行代码，将窗体中三个文本框名称中的最后一个序号设成变量，在文本框中循环并清空其内容。
对于工作表中的控件，如下面的代码所示。

Private Sub CommandButton1_Click()Dim i As IntegerFor i = 1 To 4Me.OLEObjects("TextBox" & i).Object.Text = ""Next
End Sub

代码解析：
工作表中按钮的单击事件，在工作表中的三个文本框中循环，清空文本框的内容。
第4行代码，将工作表中四个文本框名称中的最后一个序号设成变量，使用OLEObjects方法在工作表中的文本框中循环。
OLEObjects方法返回图表或工作表上单个OLE对象（OLEObject）或所有OLE对象的集合（OLEObjects集合）的对象，语法如下：

expression.OLEObjects(Index)

• 参数expression必需的，返回一个Chart 对象或Worksheet 对象。
• 参数Index：可选的，OLE对象的名称或编号。
  注意：控件的名称是指控件在属性窗口中的名称，如图所示。如果控件的名称没有规律不适用此方法。

图 119 1 控件属性窗口中的名称

119.2 使用对象类型遍历控件

如果控件的名称没有规律，可以使用For Each…Next 语句循环遍历所有控件，使用TypeName函数返回控件的对象类型，根据控件的对象类型进行相应的操作。
对于窗体中的控件，如下面的代码所示。

Private Sub CommandButton1_Click()Dim Ctr As ControlFor Each Ctr In Me.ControlsIf TypeName(Ctr) = "TextBox" ThenCtr = ""End IfNext
End Sub

代码解析：
按钮的单击事件，遍历所有控件并把所有文本框的内容清空。
第2行代码，声明变量类型。
第3行代码，使用For Each…Next 语句遍历窗体所有控件。
第4行代码，使用TypeName 函数返回变量的对象类型。
TypeName 函数返回一个字符串，提供有关变量的信息，语法如下：

TypeName(varname)

参数varname是必需的，它包含用户定义类型变量之外的任何变量。
如果变量Ctr是文本框控件，无论该文本框的名称是否已经被修改，TypeName(Ctr)都会返回“TextBox”字符串。
对于工作表中的控件，则使用下面的代码。

Private Sub CommandButton1_Click()Dim Obj As OLEObjectFor Each Obj In Me.OLEObjectsIf TypeName(Obj.Object) = "TextBox" ThenObj.Object.Text = ""End IfNext
End Sub

119.3 使用程序标识符遍历控件

工作表中的ActiveX控件还可以根据控件的程序标识符找到相应的控件，如下面的代码所示。

Private Sub CommandButton1_Click()Dim Obj As OLEObjectFor Each Obj In Me.OLEObjectsIf Obj.progID = "Forms.TextBox.1" ThenObj.Object.Text = ""End IfNext
End Sub

代码解析：
工作表中按钮的单击事件，遍历工作表中的所有控件并把工作表中所有文本框的内容清空。
第2行代码，声明变量类型。
第3行代码，使用For Each…Next 语句遍历工作表中的所有控件。
第4行代码，使用控件的ProgId 属性返回控件的程序标识符。
ProgId 属性返回控件的程序标识符，语法如下：

expression.ProgId

参数expression是必需的，一个有效的对象。
ActiveX 控件的程序标识符如表格 119 1所示。
控件名称 标识符
复选框 Forms.CheckBox.1
组合框 Forms.ComboBox.1
命令按钮 Forms.CommandButton.1
框架 Forms.Frame.1
图像 Forms.Image.1
标签 Forms.Label.1
列表框 Forms.ListBox.1
多页 Forms.ListBox.1
选项按钮 Forms.OptionButton.1
滚动条 Forms.ScrollBar.1
旋转按钮 Forms.SpinButton.1
TabStrip Forms.TabStrip.1
文字框 Forms.TextBox.1
切换按钮 Forms.ToggleButton.1
表格 119 1 ActiveX 控件的程序标识符
文本框控件返回的程序标识符是“Forms.TextBox.1”，此返回值并不受文本框控件名称的影响，所以根据工作表中控件的程序标识符可以找出全部文本框控件。

119.4 使用名称中的变量遍历图形

如果工作表中有多个图形，可以根据名称的序号使用For…Next 语句遍历图形，如下面的代码所示。

Private Sub CommandButton1_Click()Dim i As IntegerFor i = 1 To 3Me.Shapes("文本框 " & i).TextFrame.Characters.Text = "TextBox" & iNext
End Sub

代码解析：
工作表中按钮的单击事件，在工作表中的三个图形文本框中依次写入“TextBox1”、“TextBox2”和“TextBox3”字符串。
第3行到第5行代码，使用Shapes属性在工作表上的三个图形文本框中循环。
Shapes属性返回Shapes对象，代表工作表或图形工作表上的所有图形，可以使用Shapes(index)（其中index是图形的名称或索引号）返回单个的Shape对象。
返回单个的Shape对象后使用Characters 方法向图形文本框中添加字符。Characters 方法的语法如下：

expression.Characters(Start, Length)

参数expression是必需的，返回一个指定文本框内Characters对象的表达式。
参数Start是可选的，表示将要返回的第一个字符。如果此参数设置为 1 或被忽略，则Characters方法会返回以第一个字符为起始字符的字符区域。
参数Length是可选的，表示要返回的字符个数。如果此参数被忽略，则Characters 方法会返回该字符串的剩余部分。

119.5 使用FormControlType属性遍历图形

如果工作表中的是窗体控件，可以使用For Each…Next语句遍历工作表中图形并根据其FormControlType属性返回特定的窗体控件，如下面的代码所示。

Private Sub CommandButton2_Click()Dim myShape As ShapeFor Each myShape In Sheet4.ShapesIf myShape.Type = msoFormControl ThenIf myShape.FormControlType = xlCheckBox ThenmyShape.ControlFormat.Value = 1End IfEnd IfNext
End Sub

代码解析：
工作表中按钮的单击事件，清除工作表中所有的复选框。
第2行代码声明变量myShape为图形对象。
第3行代码使用For Each…Next语句遍历工作表中的图形。
第4行代码根据图形的Type属性判断图形是否为窗体控件。应用于Shape对象的Type属性返回或设置图形类型，窗体控件返回常量msoFormControl。
第5行代码根据控件的FormControlType属性判断窗体控件是否为复选框控件。FormControlType属性返回窗体控件的类型，可以为表格 119 2所示的XlFormControl常量之一。

常量	值	控件类型
xlButtonControl	0	按钮
xlCheckBox	1	复选框
xlDropDown	2	组合框
xlGroupBox	4	分组框
xlLabel	5	标签
xlListBox	6	列表框
xlOptionButton	7	选项按钮
xlScrollBar	8	滚动条
xlSpinner	9	微调项

第6行代码使用ControlFormat属性返回工作表中的复选框，并将其他Value属性设置为1选中复选框，如果需要取消复选框只需将Value属性设置为-4146。

120. 使微调框最小变动量小于1

在用微调框调节数值时，默认的变动量只能设置成整数。为了使微调框的变动量小于1，如每次的变动量为0.01，需要在代码中做必要的设置，如下面的代码所示。

Private Sub UserForm_Initialize()With Me.SpinButton1.Max = 10000.Min = -10000.SmallChange = 1.Value = 0Me.TextBox1 = Format(.Value, "0.00")End With
End Sub
Private Sub SpinButton1_Change()Me.TextBox1 = Format(Me.SpinButton1 * 0.01, "0.00")
End Sub

代码解析：
使用微调框调节文本框的数值，每次的变动量为0.01。
第1行代码到第9行代码，窗体的初始化事件，在窗体显示时对微调框控件进行必要的设置。
第3、4行代码，设置微调框控件的Max、Min 属性。Max、Min 属性规定滚动条或数值调节钮的 Value 属性可接收的最大值和最小值，语法如下：

object.Max [= Long]
object.Min [= Long]

参数object是必需的，一个有效的对象。
参数Long是可选的，指定Value属性的最大设置值或最小设置值。
第5行代码，设置微调框控件的SmallChange属性为1。SmallChange属性设定当用户单击滚动条或数值调节钮中的滚动箭头时发生的变动量，语法如下：

object.SmallChange [= Long]

参数object是必需的，一个有效的对象。
参数Long是可选的，设定Value属性的变动量。
SmallChange属性只能设置为整数。
第6行代码，设置窗体显示时微调框控件的Value属性为0。
第7行代码，使用Format函数将将文本框的初始值格式化为“0.00”。关于Format函数请参阅技巧102 。
第11行代码，微调框控件的Change事件，在微调框控件的Value属性发生变动时，将变动量乘0.01后赋给文本框，使文本框的变动量每次为0.01。
窗体运行后效果如图 120 1所示。

图 120 1 微调框变动量小于1

121. 不打印工作表中的控件

在打印工作表时，如果工作表中有控件，会把控件也一起打印出来，从而影响打印出来的工作表的美观。经过简单的设置能使工作表中的控件不被打印出来。
121-1 设置控件格式
如果工作表中的是窗体控件，设置时右键单击控件，在显示的右键快捷菜单中选择“设置控件格式”，在“设置控件格式”选项卡中选择“属性”页面，使“打印对象”前的复选框为空白状态，如图 121 1所示。

图 121 1 窗体控件
如果工作表中的控件是ActiveX控件，那么需要在设计模式下右键单击控件，在显示的右键快捷菜单中选择“设置控件格式”，在“设置控件格式”选项卡中选择“属性”页面，使“打印对象”前的复选框为空白状态，如图 121 2所示。

图 121 2 ActiveX控件
121-2 设置控件的printobjcet属性
如果工作表中的控件是ActiveX控件，使用除了使用技巧121-1的方法外，还可以在设计模式下右键单击控件，选择“属性”，设置控件的printobjcet属性为False。如图 121 3所示。

图 121 3 设置控件printobjcet属性

122. 在框架中使用滚动条

如果需要在窗体中显示较多的内容，比如使用标签显示一段很长的文本内容，而又不希望窗体很大的话，可以在窗体中使用框架放置标签，设置框架可滚动区域的高度，使标签可以进行上下移动以查看全部区域。
在VBE窗口中单击菜单“插入”→“用户窗体”，在窗体中添加一个框架控件，在框架中添加一个标签控件。根据需要显示的内容调整好标签的大小，再将框架和窗体调整为合适的大小。
在VBE中双击窗体，写入下面的代码。

Private Sub UserForm_Initialize()Dim sLab As StringsLab = Space(4) & "欢迎来到ExcelHome技术论坛，全球最领先的Excel技术论坛之一。" & vbLf _& Space(4) & "在这里，我们讨论Microsoft Office系列产品的应用技术，重点讨论Microsoft Excel。本论坛从属于Excel Home这一全球最大的华语Excel技术门户，目前是个人、非营利性质的网站学习平台。各行各业的Excel使用者都活跃在此，各种形式的学习资源也汇聚于在此，所以，只要您愿意花时间，并使用正确的方法，我们有理由相信您的绝大部分应用问题和学习愿望都在这里被满足。无数已经取得了非凡进步的人，也可以证明这一点。" & vbLf _& Space(4) & "Let’s do it better!这是Excel Home的口号，我们的宗旨是帮助大家解决在使用Office软件中的问题，提升自己的应用技能。" & vbLf _& Space(4) & "鉴于许多人在此之前没有正确使用网络学习资源的经验，或者对Excel Home的行为规则缺乏了解，我们特别准备了这样一篇文章，送给每一位有志与我们一起成长的朋友。本文将重点叙述学习方法和论坛的规则，对于如何使用论坛的各项功能，请阅读论坛的帮助系统（http://club.excelhome.net/boardhelp.asp ）"Label1.Caption = sLabWith Frame1.ScrollBars = 2.ScrollHeight = Label1.HeightEnd With
End Sub

代码解析：
窗体的初始化事件，在窗体加载时使用标签显示文本内容。
第3行到第6行代码，变量sLab为要显示的文本，使用Space函数在每段的首字前插入4个空格，使首字缩进。在需要换行的地方插入常数vbLf进行换行。
第9行代码，设置框架的ScrollBars属性为显示垂直滚动条。ScrollBars属性指定一个控件、窗体或页面是否有垂直或水平滚动条，或两者都有，语法如下：

object.ScrollBars [= fmScrollBars]

参数object是必需的，一个有效的对象。
参数fmScrollBars是可选的，滚动条的显示位置，设置值如表格 122 1所示。
常量 值 说明
fmScrollBarsNone 0 不显示滚动条（默认）。
fmScrollBarsHorizontal 1 显示水平滚动条。
fmScrollBarsVertical 2 显示垂直滚动条。
fmScrollBarsBoth 3 垂直和水平滚动条都显示。
表格 122 1 ScrollBars属性设置值
第10行代码，设置框架的ScrollHeight属性为标签的高度。ScrollHeight属性指定通过移动控件、窗体或页面中的滚动条，可以查看的全部区域的高度，语法如下：

object.ScrollHeight [= Single]

参数object是必需的，一个有效的对象。
参数Single是可选的，可滚动区域的高度。
如果框架具有水平滚动条，可以设置框架的ScrollWidth属性来设置可以查看的全部区域的宽度。
运行窗体，使用标签显示文本内容，可通过框架的滚动条查看全部内容，如图 122 1所示。

图 122 1 在框架中使用滚动条

123. 使用多页控件

在处理可以划分为不同类别的大量信息时可以使用多页控件。例如，在示例中，多页控件的第一页用于显示欢迎信息，另三页显示其他信息。利用多页控件能够将相关信息组织在一起显示出来，同时又能够随时访问整条记录。
多页控件中的每个页面都是一个窗体，含有自己的控件，并且可以有唯一的布局。一般情况下，多页控件中的页面都有标签，以便让用户选择单个页面。
在窗体中使用多页控件时，往往希望窗体显示时能显示特定的页面，比如每次打开窗体时先显示第一页的欢迎信息，除了在VBE中选择多页控件的第一页后保存外，还可以通过设置多页控件的Value属性来实现，如下面的代码所示。

Private Sub UserForm_Initialize()MultiPage1.Value = 0
End Sub

代码解析：
窗体的Initialize事件，在窗体显示时选择多页控件的第一页。
控件的Value属性定义某给定的控件的状态或内容，对于多页控件标识当前激活页。
Value属性是多页控件的默认属性，该属性返回当前活动页面的索引编号（位于多页控件的Pages集合中），零 ( 0 ) 表示是第一页，最大值比总页数少一。
多页控件的默认事件是Change事件，示例中使用消息框显示当前活动页面的Caption属性，代码如下：

Private Sub MultiPage1_Change()If MultiPage1.SelectedItem.Index > 0 ThenMsgBox "欢迎来到" & MultiPage1.SelectedItem.Caption & "版块!"End If
End Sub

代码解析：
MultiPage1_Change过程根据当前活动页面是否是第一页，如果不是则使用消息框显示当前活动页面的Caption属性。
应用于Page对象的Index属性指Pages集合中Page对象的位置，语法如下：

object.Index [= Integer]

参数object是必需的，一个有效对象。
参数Integer是可选的，当前选定的Page对象的索引。
Index 属性指定了标签出现的顺序，改变Index属性的值将改变多页控件中页面的顺序，第一页的索引值是0，第二页的索引值是 1，依此类推。
应用于多页控件的SelectedItem属性返回当前选中的Page对象，SelectedItem属性是只读的，用SelectedItem属性可对当前选中的Page对象进行可编程控制。
运行窗体，多页控件显示第一页的欢迎信息，当选择其他页面时显示提示信息，如图 123 1所示。

图 123 1 使用多页控件

124. 标签文字垂直居中对齐

在使用标签控件为其他控件作题注时，只能设置题注文字在水平方向的对齐方式，不能设置为垂直居中。要达到题注文字垂直居中的效果，可以使用两个标签控件组合来完成。
步骤1，在窗体中添加一个标签控件Label1，将Caption属性设置为空，再设置需要的背景颜色及边框颜色。
步骤2，添加一个标签控件Label2，将Caption属性设置为需要的标题；AutoSize属性设置为True，BackStyle属性设置为0，TextAligh属性设置为fmTextAlignCenter，其它属性不改变。
AutoSize属性规定对象是否自动调整大小以显示其完整的内容，语法如下：

object.AutoSize [= Boolean]

参数object是必需的，一个有效对象。
参数Boolean是可选的，是否自动调整大小。设置值为True控件可自动调整大小以显示其完整的内容，设置为False控件尺寸保持不变。如果内容超出了控件的区域，内容将被剪裁（默认）。
BorderStyle属性指定控件或窗体的边框类型，语法如下：

object.BorderStyle [= fmBorderStyle]

参数object是必需的，一个有效对象。
参数fmBorderStyle是可选的，指定边框类型，设置值如表格 124 1所示。
常量 值 描述
fmBackStyleTransparent 0 背景为透明
fmBackStyleOpaque 1 背景为不透明（默认值）
表格 124 1 fmBorderStyle设置值
TextAligh属性定义控件中文本的对齐方式，语法如下：

object.TextAlign [= fmTextAlign]

参数object是必需的，一个有效对象。
参数fmTextAlign是可选的，控件中文本的对齐方式，设置值如表格 124 2所示。
常量 值 描述
fmTextAlignLeft 1 将所显示文本的第一个字符与控件显示或编辑区的左边界对齐（默认值）。
fmTextAlignCenter 2 在控件的显示或编辑区中，使文本中央对齐
fmTextAlignRight 3 将所显示文本的最后一个字符与控件显示或编辑区的右边界对齐。
表格 124 2 fmTextAlign设置值
步骤3，同时选中两个标签控件，在右键弹出菜单中选择“统一尺寸”→“宽度相同”，再右击选择“对齐”→“左对齐”，重新右键“对齐”→“中间对齐”。
步骤4，最后同时选中两个标签控件，在右键弹出菜单中选择“生成组”，就达到标题为垂直居中的效果了，如图 124 1窗体中左边的标签所示。

图 124 1 标签控件标题垂直居中

125. 使用TabStrip控件

使用TabStrip控件，可以在用户窗体中的同一区域定义多个数据页面，也就是说使用TabStrip控件可以使用户窗体中的同一组控件根据TabStrip控件所选择的页面具有不同的功能，而不必像多页控件那样需要在每个页面中放置相同的控件。
在示例的窗体中使用一个图像控件和一个标签控件，根据TabStrip控件所选择的页面来显示相应城市的图片和标签控件的题注。
步骤1，在窗体中添加一个TabStrip控件，默认情况下，一个TabStrip控件包含两个页面，所以需要在TabStrip控件上右键单击，在显示的右键菜单中选择“新建页”继续添加三个页面。因为TabStrip控件不像多页控件具有分页的属性窗口，所以需要在显示的右键菜单中选择“重命名”将页面分别重命名为各城市的名称。
步骤2，在TabStrip控件上添加一个Image控件和一个Label控件，调整为合适的大小。
步骤3，双击窗体写入下面的代码：

Private Sub TabStrip1_Change()Dim FilPath As StringFilPath = ThisWorkbook.Path & "\" & TabStrip1.SelectedItem.Caption & ".jpg"Image1.Picture = LoadPicture(FilPath)Label1.Caption = TabStrip1.SelectedItem.Caption & "欢迎您!"
End Sub
Private Sub UserForm_Initialize()TabStrip1.Value = 0
End Sub

代码解析：
第1行到第6行代码，TabStrip控件的Change事件过程，根据TabStrip控件所选择的页面来显示相应城市的图片和标签控件的题注。
第3行代码设置Image控件需加载图片的完整路径，使用SelectedItem属性返回TabStrip控件当前选中页面的Caption属性，即窗体中所选城市的名称，将图片的完整路径设置为保存在同一目录中已命名为所选城市的图片。
第4行代码为Image控件加载图片。Picture 属性指定显示在对象上的位图，语法如下：

object.Picture = LoadPicture( pathname )

参数expression是必需的，一个有效的对象。
参数pathname是必需的，一个图片文件的完整路径。
第5行代码设置标签控件的题注为窗体中所选城市的名称和“欢迎您!”。
第7行到第9行代码窗体的Initialize事件过程，为了使窗体显示时TabStrip控件显示第一页，将其Value设置为零 ( 0 )。
运行窗体，选择不同的标签将显示不同城市的图片，如图 125 1所示。

图 125 1 使用TabStrip控件（一）
如果将TabStrip控件的Style属性设置为1则在标签条中显示的是按钮而不是标签，如图 125 2所示。

图 125 2 使用TabStrip控件（二）

126. 显示GIF动画图片

如果希望在Excel中显示GIF格式的动画图片，可以使用AniGif控件。
步骤1，在工作表中单击菜单“视图”→“工具栏”→“控件工具箱”→“其他控件”，选择“VBAniGIF. AniGif”后在工作表中拖动添加AniGif控件，如图 126 1所示。

图 126 1 添加AniGif控件
如果“其他控件”中没有该控件，那么需要对该控件进行注册。注册控件请参阅技巧118 。AniGif控件的文件名为VBAniGIF.OCX，也可以在工作表中单击菜单“视图”→“工具栏”→“控件工具箱”→“其他控件”，选择“注册自定义控件”，在显示的对话框中选择VBAniGIF.OCX文件进行注册，如图 126 2所示。

图 126 2 注册AniGif控件
步骤2，在设计模式下右键单击AniGif控件，选择“属性”，设置AniGif控件的Filename属性为CIF图片所在的路径，如图 126 3所示。

图 126 3 设置Filename属性
可以使用代码设置AniGif控件的Filename属性，如下面的代码所示。

Private Sub Workbook_Open()Sheet1.AniGif1.Filename = ThisWorkbook.Path & "\001.gif"
End Sub

代码解析：
工作簿打开时将AniGif控件的Filename属性设置为同一目录中的“001.gif”文件。
工作簿打开时可能出现如图 126 4所示的对话框，这是因为当打开包含ActiveX控件的文件时，如果该控件被标识为初始化不安全时，Office程序不加载或激活未被标志为初始化安全的ActiveX控件。

图 126 4 初始化不安全ActiveX控件提示
解决此问题的方法是更改Office程序处理ActiveX组件的方式，需要对注册表进行修改。也可以使用以下代码修改注册表：

Sub RegWriteProc()Dim WshShellSet WshShell = CreateObject("Wscript.Shell")WshShell.RegWrite "HKCU\Software\Microsoft\Office\Common\Security\UFIControls", 1, "REG_DWORD"WshShell.RegWrite "HKCU\Software\Microsoft\VBA\Security\LoadControlsInForms", 1, "REG_DWORD"Set WshShell = Nothing
End Sub

代码解析：
RegWriteProc过程修改注册表设置。第4行代码将UFIControls子项设置为1（最不安全）。第5行代码将LoadControlsInForms子项设置为1（最不安全）。关于为ActiveX控件授予权限请参阅微软的技术文章：http://support.microsoft.com/kb/827742/zh-cn
退出设计模式后，将在工作表中显示GIF动画图片，如图 126 5所示。

图 126 5 显示GIF动画图片

127. 播放Flash文件

如果需要在工作表中播放Flash文件，那么可以使用ShockwaveFlash控件。
步骤1，在工作表中单击菜单“视图”→“工具栏”→“控件工具箱”→“其他控件”，选择“ShocKwave Flash Object”后在工作表中拖动添加ShockwaveFlash控件，如图 127 1所示。

图 127 1 添加ShockwaveFlash控件
如果“其他控件”中没有该控件，请参阅技巧126 对其进行注册，ShockwaveFlash控件的文件名为Flash9d.OCX。
步骤2，在设计模式下右键单击ShockwaveFlash控件，选择“属性”，设置ShockwaveFlash控件的Base属性和Movie属性为Flash文件所在的路径，设置Embedmovie属性为True，使Flash文件嵌入到Excel中，如图 127 2所示。

图 127 2 设置ShockwaveFlash控件属性
可以使用代码设置ShockwaveFlash控件的各项属性，如下面的代码所示。

Private Sub Workbook_Open()With Sheet1.ShockwaveFlash1.Base = ThisWorkbook.Path & "\face.swf".Movie = ThisWorkbook.Path & "\face.swf".EmbedMovie = TrueEnd With
End Sub

代码解析：
工作簿打开时将ShockwaveFlash控件的Base属性和Movie属性设置为同一目录中的“face.swf”文件，设置Embedmovie属性为True。
退出设计模式后，将在工作表中显示Flash动画，如图 127 3所示。

图 127 3 显示Flash动画

128. 在工作表中添加窗体控件

在工作表中添加窗体控件，除了使用手工添加外，还可以使用代码添加，方法如下：
128-1 使用AddFormControl方法
使用AddFormControl方法在工作表中添加窗体控件，如下面的代码所示。

Sub AddFormControls()Dim myShape As ShapeOn Error Resume NextSheet1.Shapes("myButton").DeleteSet myShape = Sheet1.Shapes.AddFormControl(0, 108, 72, 108, 27)With myShape.Name = "myButton"With .TextFrame.Characters.Font.ColorIndex = 3.Font.Size = 12.Text = "新建的按钮"End With.OnAction = "myButton"End With
End Sub
Sub myButton()MsgBox "这是使用AddFormControl方法新建的按钮!"
End Sub

代码解析：
AddFormControls过程使用AddFormControl方法在工作表中添加窗体控件。
第3、4行代码为了避免在工作表中重复添加按钮控件，先删除工作表中的“myButton”按钮。
第5行代码，使用AddFormControl方法在工作表中添加命令按钮控件并设置控件的坐标和大小。应用于Shapes对象的AddFormContl方法创建一个Microsoft Excel控件，返回一个Shape对象，该对象代表新建的控件，语法如下：

expression.AddFormControl(Type, Left, Top, Width, Height)

参数expression是必需的，一个有效的对象。
参数Type是必需的，Microsoft Excel控件类型，可以为表格 128 1所列XlFormControl 常量之一。
常量 值 说明
xlButtonControl 0 命令按钮
xlCheckBox 1 复选框
xlDropDown 2 组合框
xlEditBox 3 编辑框
xlGroupBox 4 分组框
xlLabel 5 标签
xlListBox 6 列表框
xlOptionButton 7 选项按钮
xlScrollBar 8 滚动条
xlSpinner 9 微调项
表格 128 1 XlFormControl 常量
参数Left是必需的，新对象的初始坐标（以磅为单位）相对于工作表 A1 单元格的左上角或图表的左上角。
参数Top是必需的，新对象的初始坐标（以磅为单位）相对于工作表 A1 单元格的左上角或图表的左上角。
参数Width是必需的，以磅为单位的新对象的初始大小。
参数Height是必需的，以磅为单位的新对象的初始大小。
第7行代码将新添加的按钮名称设置为“myButton”。
第8行到第12行代码设置新添加的按钮文字设置为“新建的按钮”，并设置文字的大小和颜色。
第13行代码，指定新添加按钮所执行的宏名称。
myButton过程是单击新添加按钮所执行的过程，显示一个消息框。
运行AddFormControls过程将在工作表中添加一个命令按钮，单击按钮显示一个消息框，如图 128 1所示。

图 128 1 使用AddFormControl方法添加窗体控件
128-2 使用Add方法
在工作表中添加窗体控件还可以使用Add方法，如下面的代码所示。

Sub AddChartObjects()Dim myButton As ButtonOn Error Resume NextSheet1.Shapes("myButton").DeleteSet myButton = Sheet1.Buttons.Add(108, 72, 108, 27)With myButton.Name = "myButton".Font.Size = 12.Font.ColorIndex = 5.Characters.Text = "新建的按钮".OnAction = "myButton"End With
End Sub
Sub myButton()MsgBox "这是使用Add方法新建的按钮!"
End Sub

代码解析：
AddChartObjects过程使用Add方法在工作表中添加窗体控件。
第3、4行代码为了避免在工作表中重复添加按钮控件，先删除工作表中的“myButton”按钮。
第5行代码，使用Add方法在工作表中添加命令按钮控件，Add方法适用于ChartObjects对象的语法如下：

expression.Add(Left, Top, Width, Height)

参数expression是必需的，该表达式返回一个ChartObjects对象。
如果需要在工作表中添加其他窗体控件，可以将参数expression设置为表格 128 2所示的ChartObjects对象之一。
类型 ChartObjects对象
复选框 CheckBoxes
组合框 DropDowns
标签 Labels
列表框 ListBoxes
选项按钮 OptionButtons
滚动条 ScrollBars
微调项 Spinners
表格 128 2 ChartObjects对象
参数Left和Top是必需的，以磅为单位给出新对象的初始坐标，该坐标是相对于工作表上单元格 A1 的左上角或图表的左上角的坐标。
参数Width和参数Height是必需的，以磅为单位给出新对象的初始大小。
第7行代码将新添加的按钮的名称设置为“myButton”。
第8行到第10代码新添加的按钮的文字设置为“新建的按钮”并设置文字的大小和颜色。
第11行代码，指定新添加命令按钮所执行的宏名称。
myButton过程是单击新添加按钮所执行的过程，显示一个消息框。
运行AddChartObjects过程将在工作表中添加一个命令按钮，单击按钮显示一个消息框，如图 128 2所示。

图 128 2 使用Add方法添加窗体控件

129. 在工作表中添加ActiveX控件

技巧128 中使用代码在工作表中添加的是窗体控件，而本例中使用代码在工作表中添加的是ActiveX控件，两者是有区别的，在工作表中前者是使用窗体对话框添加，而后者是使用控件工具箱添加，如图 129 1所示。

图 129 1 窗体控件和ActiveX控件的区别

129.1 使用Add方法

使用Add方法在工作表中添加ActiveX控件，如下面的代码所示。

Sub AddObj()Dim Obj As New OLEObjectOn Error Resume NextSheet1.OLEObjects("MyButton").DeleteSet Obj = Sheet1.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _Left:=108, Top:=72, Width:=108, Height:=27)With Obj.Name = "MyButton".Object.Caption = "新建的按钮".Object.Font.Size = 16.Object.ForeColor = &HFF&End WithWith ActiveWorkbook.VBProject.VBComponents(Sheet1.CodeName).CodeModuleIf .Lines(1, 1) <> "Option Explicit" Then.InsertLines 1, "Option Explicit"End IfIf .Lines(2, 1) = "Private Sub MyButton_Click()" Then Exit Sub.InsertLines 2, "Private Sub MyButton_Click()".InsertLines 3, vbTab & "MsgBox ""这是使用Add方法新建的按钮!""".InsertLines 4, "End Sub"End With
End Sub

代码解析：
AddOLEObject过程使用Add方法在向工作表中添加ActiveX控件中的命令按钮和相应的代码。
第3、4行代码为了避免在工作表中重复添加按钮控件，先删除工作表中的名称为“myButton”的按钮。
第5、6行代码，使用Add方法在向工作表中添加ActiveX控件中的命令按钮，Add方法应用于OLEObjects 对象的语法如下：

expression.Add(ClassType, FileName, Link, DisplayAsIcon, IconFileName, IconIndex, IconLabel, Left, Top, Width, Height)

其中参数expression是必需的，返回一个 OLEObjects 对象。
参数ClassType是可选的，创建的对象的程序标识符。如果指定了 ClassType参数，则忽略FileName参数和Link参数。
在本例中指定添加控件的程序标识符为“Forms.CommandButton.1”，即命令按钮控件，关于对象的程序标识符请参阅技巧119-3。
参数Left和参数Top是必需的，以磅为单位给出新对象的初始坐标，该坐标是相对于工作表上单元格 A1 的左上角或图表的左上角的坐标。
参数Width和参数Height是可选的，以磅为单位给出OLE对象的初始大小。
第8行代码，设置命令按钮的名称为“MyButton”。
第9行代码，设置命令按钮的文字为“新建的按钮”
第10行代码，设置命令按钮的文字的大小。
第11行代码，设置命令按钮的文字的颜色。
第13行到第21行代码，在工作表中写入新添加的命令按钮的单击事件代码。
ActiveX控件不能像窗体控件用OnAction属性来指定宏，需要使用CodeModule对象的InsertLines方法在工作表中插入代码。
应用于CodeModule对象的InsertLines方法的语法如下：

object.InsertLines(line, code)

参数object：必需的，一个有效的对象。
参数line是必需的，用来指定要插入代码的位置。
参数code是必需的，要插入的代码。
第14行到第16行代码判断首行内容是否为要求变量声明，如不是则添加要求变量声明语句。
第17行到第20行代码判断是否已存在相同名称的过程，如不存在则使用InsertLines方法在工作表中插入代码。
运行AddOLEObject过程，将在工作表中添加一个命令按钮和相应的代码，单击按钮显示一个消息框，如图 129 2所示。

图 129 2 使用Add方法添加ActiveX控件

129.2 使用AddOLEObject方法

在工作表中添加ActiveX控件，还可以使用AddOLEObject方法，如下面的代码所示。

Sub AddShapes()Dim ShpBut As ShapeOn Error Resume NextSheet1.OLEObjects("MyButton").DeleteSet ShpBut = Sheet1.Shapes.AddOLEObject(ClassType:="Forms.CommandButton.1", _Left:=108, Top:=72, Width:=108, Height:=27)ShpBut.Name = "MyButton"With ActiveWorkbook.VBProject.VBComponents(Sheet1.CodeName).CodeModuleIf .Lines(1, 1) <> "Option Explicit" Then.InsertLines 1, "Option Explicit"End IfIf .Lines(2, 1) = "Private Sub MyButton_Click()" Then Exit Sub.InsertLines 2, "Private Sub MyButton_Click()".InsertLines 3, vbTab & "MsgBox ""这是使用AddOLEObject方法新建的按钮!""".InsertLines 4, "End Sub"End With
End Sub

代码解析：
AddShapes过程使用AddOLEObject方法在向工作表中添加ActiveX控件中的命令按钮和相应的代码。
第5、6行代码，使用AddOLEObject方法在向工作表中添加ActiveX控件中的命令按钮，AddOLEObject方法创建OLE对象，语法如下：

expression.AddOLEObject(ClassType, FileName, Link, DisplayAsIcon, IconFileName, IconIndex, IconLabel, Left, Top, Width, Height)

AddOLEObject方法参数与Add方法类似，请参阅技巧129-1。
运行AddShapes过程，将在工作表中添加一个命令按钮和相应的代码，单击按钮显示一个消息框，如图 129 3所示。

图 129 3 使用AddOLEObject方法添加ActiveX控件

130. 使用spreadsheet控件

如果希望在窗体中显示类似工作表的表格，并且可以像工作表一样进行操作，那么可以在窗体中使用表格控件（Spreadsheet控件）。
步骤1，在VBE窗口中单击菜单“插入”→“用户窗体”，在窗体上添加一个Spreadsheet控件，双击窗体，在其代码窗口中输入下面的代码：

Private Sub UserForm_Initialize()Dim iRow As IntegerDim arr As VariantWith Me.Spreadsheet1.DisplayToolbar = False.DisplayHorizontalScrollBar = False.DisplayVerticalScrollBar = False.DisplayWorkbookTabs = FalseiRow = Sheet1.Range("B65536").End(xlUp).Rowarr = Sheet1.Range("B2:H" & iRow)With .Range("B2:H" & iRow).Value = arr.Borders.LineStyle = xlContinuous.Borders.Weight = xlMedium.Borders.ColorIndex = 10End WithWith .Range("B2:H2").HorizontalAlignment = -4108.VerticalAlignment = -4108.Interior.ColorIndex = 44End With.Range("B3:B" & iRow).HorizontalAlignment = -4108.Range("C3:H" & iRow).NumberFormat = "0.00".Rows(2).RowHeight = 23.25.Columns("A").ColumnWidth = 2.75.Columns("B:H").ColumnWidth = 8End With
End Sub

代码解析：
用户窗体的初始化事件过程，使用窗体显示工作表中的表格。
第5行代码，设置Spreadsheet控件不显示工具栏。
DisplayToolbar 属性设置工具栏是否隐藏，语法如下：

expression.DisplayToolbar

参数expression是必需的，一个有效的对象。
如果指定电子表格、图表区或“数据透视表”列表显示了工具栏，则返回True。
第6、7行代码，设置Spreadsheet控件不显示水平和垂直滚动条。
第8行代码，设置Spreadsheet控件不显示工作表标签。
第9行代码，取得工作表B列有数据的最后一行的行号。
第10行代码，把工作表数据赋值给数组。
第11行到16行代码，把数组赋给Spreadsheet控件的单元格，使Spreadsheet控件显示工作表内容，并且添加加框线。
第17行到第21行代码，设置Spreadsheet控件中表格第一行的字体对齐方式为居中并添加单元格的底纹颜色。
第22行代码，设置Spreadsheet控件中表格第一列的字体对齐方式为居中。
第23行代码，设置Spreadsheet控件中表格数据的格式。
第24行到26行代码，设置Spreadsheet控件的行高与列宽。
步骤2，在窗体上添加一个按钮控件，将其Caption属性设置为“保存”，双击按钮控件，在其代码窗口中输入下面的代码：

Private Sub CommandButton1_Click()Dim iRow As IntegerDim arr As VariantIf MsgBox("是否保存对表格所作的修改?", 4 + 32) = 6 ThenWith Me.Spreadsheet1iRow = .Range("B65536").End(xlUp).Rowarr = .Range("B2:H" & iRow).ValueSheet1.Range("B2:H" & iRow).Value = arrEnd WithEnd IfUnload Me
End Sub

代码解析：
用户窗体中“保存”按钮的单击过程，把在窗体中对数据的修改重新保存到工作表。
第4行代码，询问用户是否保存修改。
第5行到第10行代码，如果用户选择保存，把Spreadsheet控件中的数据保存到工作表。
运行窗体，显示效果如图 130 1所示。

图 130 1 使用Spreadsheet控件

131. 使用Listview控件

ListView控件是VBA程序开发中的常用控件，可以用来显示各项带图标的列表，也可以用来显示带有子项的列表。
131-1 使用Listview控件显示数据列表
使用Listview控件在用户窗体中显示数据列表，代码如下：

Private Sub UserForm_Initialize()Dim Itm As ListItemDim r As IntegerDim c As IntegerWith ListView1.ColumnHeaders.Add , , "人员编号 ", 50, 0.ColumnHeaders.Add , , "技能工资 ", 50, 1.ColumnHeaders.Add , , "岗位工资 ", 50, 1.ColumnHeaders.Add , , "工龄工资 ", 50, 1.ColumnHeaders.Add , , "浮动工资 ", 50, 1.ColumnHeaders.Add , , "其他  ", 50, 1.ColumnHeaders.Add , , "应发合计", 50, 1.View = lvwReport.Gridlines = TrueFor r = 2 To Sheet1.[A65536].End(xlUp).RowSet Itm = .ListItems.Add()Itm.Text = Space(2) & Sheet1.Cells(r, 1)For c = 1 To 6Itm.SubItems(c) = Format(Sheet1.Cells(r, c + 1), "##,#,0.00")NextNextEnd WithSet Itm = Nothing
End Sub

代码解析：
窗体的初始化事件，在窗体显示时将工作表中数据显示在Listview控件中。
第6行到第12行代码，使用ColumnHeader对象的Add方法在Listview控件中添加标题列，并设置列标题、列宽和文本对齐方式。
ColumnHeader对象是ListView控件中包含标题文字的项目，应用于ColumnHeader对象的Add方法语法如下：
object.ColumnHeader.Add(index,key,text,width,alignment)
其中参数text代表标题文字，参数width代表标题的列宽，参数alignment代表列标题中文本对齐方式。Listview控件中文本的对齐方法有三种，如表格 131 1所示。
常数 值 说明
lvwColumnLeft 0 文本向左对齐。（缺省值）
lvwColumnRight 1 文本向右对齐。
lvwColumnCenter 2 文本居中对齐。
表格 131 1 Listview控件中文本的对齐方法
在Listview控件中第一列的文本对齐方式只能设置为左对齐。
第13行代码，设置Listview控件的View属性为lvwReport，使Listview控件显示为报表型。View属性决定在列表中控件使用何种视图显示项目，语法如下：

object.view [= value]

参数object是必需的，对象表达式，listview控件。
参数value是必需的，指定控件外观的整数或常数，如表格 131 2所示。
常数 值 说明
lvwicon 0 图标
lvwsmallicon 1 小图标
lvwlist 2 列表
lvwreport 3 报表
表格 131 2 View属性的设置值
第14行代码，设置Listview控件的Gridlines属性为True，显示网格线。只有在将View属性设置为lvwReport时才能显示网格线，否则Gridlines属性无效。
第16行代码，使用ListItem对象的Add方法在Listview控件中添加项目。应用于ListItem对象的Add方法语法如下：

ListItems.Add(index,key,text,icon,smallIcon)

其中参数text代表添加的项目内容。
第17行代码，添加行标题。ListItem对象的text属性代表Listview控件的第一列内容，因为Listview控件的第一列的文本对齐方式只能设置为左对齐，所以在添加时使用Space函数插入两个空格，使行标题达到居中显示的效果。
第18行到20行代码，继续添加其他列的内容。Listview控件其他列的项目需要使用SubItems属性来添加。
运行窗体，Listview控件显示工作表中的内容，如图 131 1所示。

图 131 1 使用Listview控件显示数据
131-2 在Listview控件中使用复选框
在Listview控件中使用复选框，可以进行多重选择，示例代码如下：

Private Sub UserForm_Initialize()Dim Itm As ListItemDim r As IntegerDim c As IntegerWith ListView1.ColumnHeaders.Add , , "人员编号 ", 50, 0.ColumnHeaders.Add , , "技能工资 ", 50, 1.ColumnHeaders.Add , , "岗位工资 ", 50, 1.ColumnHeaders.Add , , "工龄工资 ", 50, 1.ColumnHeaders.Add , , "浮动工资 ", 50, 1.ColumnHeaders.Add , , "其他  ", 50, 1.ColumnHeaders.Add , , "应发合计", 50, 1.View = lvwReport.Gridlines = True.FullRowSelect = True.CheckBoxes = TrueFor r = 2 To Sheet2.[A65536].End(xlUp).Row - 1Set Itm = .ListItems.Add()Itm.Text = Sheet2.Cells(r, 1)For c = 1 To 6Itm.SubItems(c) = Format(Sheet2.Cells(r, c + 1), "##,#,0.00")NextNextEnd WithSet Itm = Nothing
End Sub
Private Sub CommandButton1_Click()Dim r As IntegerDim i As IntegerDim c As Integerr = Sheet1.[A65536].End(xlUp).RowIf r > 1 Then Sheet1.Range("A2:G" & r) = ""With ListView1For i = 1 To .ListItems.CountIf .ListItems(i).Checked = True ThenSheet1.Range("A65536").End(xlUp).Offset(1, 0) = .ListItems(i)For c = 1 To 6Sheet1.Cells(65536, c + 1).End(xlUp).Offset(1, 0) = .ListItems(i).SubItems(c)NextEnd IfNextEnd With
End Sub

代码解析：
第1行到第26行代码，用户窗体的Initialize事件过程，在窗体显示时将工作表中数据显示在Listview控件中，请参阅技巧0。
其中第15行代码设置Listview控件的FullRowSelect属性为True，使用户可以选择整行。
第16行代码设置Listview控件的CheckBoxes属性为True，使Listview控件在列表的每个项的旁边显示复选框。
第27行到第43行代码，用户窗体中“保存”按钮的单击过程，将Listview控件中选中的项目写入到工作表中。
第31、32行代码，删除工作表中原有的数据，
第34、35行代码遍历Listview控件中所有的ListItem对象，判定其Checked值，如果为True，即说明其处于选中状态。
第36行到第40行代码将Listview控件中选中的内容依次写入到工作表中。
运行窗体，Listview控件显示工作表中的内容，单击“保存”按钮将如Listview控件中选中的内容依次写入到工作表中，如图 131 2所示。

图 131 2 Listview控件使用复选框
131-3 调整Listview控件的行距
在使用Listview控件显示数据列表时，行距是由Listview控件所设置的字体大小决定的，无法自定义行距，即使调整了字体大小，行距还是很近。
如果需要自定义Listview控件的行距，可以在窗体中添加一个ImageList控件，在ImageList控件中导入一张大小合适的空白图片，然后指定Listview控件的SmallIcons属性为ImageList控件中的图片，代码如下：

Private Sub UserForm_Initialize()Dim Itm As ListItemDim r As IntegerDim c As IntegerDim Img As ListImageWith ListView1.ColumnHeaders.Add , , "人员编号 ", 50, 0.ColumnHeaders.Add , , "技能工资 ", 50, 1.ColumnHeaders.Add , , "岗位工资 ", 50, 1.ColumnHeaders.Add , , "工龄工资 ", 50, 1.ColumnHeaders.Add , , "浮动工资 ", 50, 1.ColumnHeaders.Add , , "其他  ", 50, 1.ColumnHeaders.Add , , "应发合计", 50, 1.View = lvwReport.Gridlines = True.FullRowSelect = TrueSet Img = ImageList1.ListImages.Add(, , LoadPicture(ThisWorkbook.Path & "\" & "1×25.bmp")).SmallIcons = ImageList1For r = 2 To Sheet1.[A65536].End(xlUp).Row - 1Set Itm = .ListItems.Add()Itm.Text = Space(2) & Sheet1.Cells(r, 1)For c = 1 To 6Itm.SubItems(c) = Format(Sheet1.Cells(r, c + 1), "##,#,0.00")NextNextEnd WithSet Itm = NothingSet Img = Nothing
End Sub

代码解析：
用户窗体的Initialize事件过程，在窗体显示时将工作表中数据显示在Listview控件中并调整Listview控件的行距。
第17行代码使用Add方法在ImageList控件中添加图片。ImageList控件是一个向其他控件提供图像的资料中心，它包含了一组ListImage对象即一组图像的集合，该集合中的每个对象都可以通过其索引或关键字被其他控件所引用，但控件本身并不能单独使用。
在运行时给ImageList控件添加图片需要使用Add方法，语法如下：

Add(index,key,picture)

参数index是可选的，整数，指定要插入的ListImage对象的位置。如果没有指定index，ListImage对象将被添加到ListImages集合的末尾。
参数key是可选的，用来标识ListImage对象的唯一字符串。
参数picture是必需的，指定欲添加到集合中的图片。
也可以在设计时在ImageList控件中添加图片，这样就无需在文件夹中保留图片文件。在VBE中选择ImageList控件属性页中的“自定义”，在显示的“属性页”对话框中插入图片，如图 131 3所示。

图 131 3 在ImageList控件中添加图片
第18行代码，指定Listview控件的SmallIcons属性为ImageList控件中的图片，使用图片来调整行距。
运行窗体，Listview控件显示工作表中的内容，调整Listview控件的行距，如图 131 4所示。

图 131 4 调整Listview控件的行距
131-4 在Listview控件中排序
在使用Listview控件显示报表型的数据时，可能通过单击Listview控件的列标题对列表数据进行排序，代码如下：

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)With ListView1.Sorted = True.SortOrder = (.SortOrder + 1) Mod 2.SortKey = ColumnHeader.Index - 1End With
End Sub

代码解析：
Listview控件的ColumnClick事件过程，单击列标题时触发，对列表数据进行升序或降序排序。
第3行代码将Listview控件的Sorted属性设置为True。Sorted属性返回或设置确定ListView控件中的ListItem对象是否排序，设置为False则不进行排序。
第4行代码设置Listview控件的排序方式。SortOrder属性返回或设置一个值，决定ListView控件中的ListItem对象以升序或降序排序，设置为0以升序排序，设置为1则以降序排序。在设置SortOrder属性值时使用Mod运算符以达到第一次排序以降序排序，再次排序时以升序排序，交替进行的效果。
第5行代码设置Listview控件排序关键字的整数，即指定Listview控件以当前选定的列数据进排序。SortKey属性返回或设置一个值，此值决定ListView控件中的ListItem对象如何排序，语法如下：

object.SortKey [=integer]

参数object是必需的，对象表达式，其值为ListView控件。
参数integer是必需的，指定排序关键字的整数，设置为0使用ListItem对象的Text属性排序，即第一列的数据进行排序。设置为大于0的整数则使用子项目的集合索引排序。
运行窗体，Listview控件显示工作表中的内容，单击列标题对列表数据进行升序或降序排序，如图 131 5所示。

图 131 5 在Listview控件中排序
131-5 Listview控件的图标设置
ListView 控件作为一个可以显示图标或者子项的列表控件，可以在控件中显示自定义的图标，它最重要的属性就是View 属性，该属性决定了以哪种视图模式显示控件的项，请参阅技巧131-1。
在ListView 控件中显示图标，需要在用户窗体中添加一个ImageList控件用于保存图像文件。关于ImageList控件的使用请参阅技巧131-3。
以大图标模式显示ListView控件的代码如下：

Private Sub UserForm_Initialize()Dim ITM As ListItemDim r As IntegerWith ListView1.View = lvwIcon.Icons = ImageList1For r = 2 To 6Set ITM = .ListItems.Add()ITM.Text = Cells(r, 1)ITM.Icon = r - 1NextEnd WithSet ITM = Nothing
End Sub

代码解析：
在用户窗体中以大图标模式显示ListView控件，可使用鼠标拖放图标，并重新排列。
第5行代码将ListView控件的View属性设置为lvwIcon，大图标视图模式。
第6行代码使用ListView控件的Icons 属性建立与ImageList控件的关联。
第7行到第11行代码在ListView控件中添加ListItem对象，其中第10行代码设置使用ListItem对象的Icon属性指定其图像文件在ImageList控件中的编号。
ListView控件以大图标视图模式显示时如图 131 6所示。

图 131 6 大图标视图模式
以小图标模式显示ListView控件的代码如下：

Private Sub UserForm_Initialize()Dim ITM As ListItemDim r As IntegerWith ListView1.View = lvwSmallIcon.SmallIcons = ImageList1For r = 2 To 6Set ITM = .ListItems.Add()ITM.Text = Sheet1.Cells(r, 1)ITM.SmallIcon = r - 1NextEnd WithSet ITM = Nothing
End Sub

代码解析：
在用户窗体中以小图标模式显示ListView控件，可使用鼠标拖放图标，并重新排列。
第5行代码将ListView控件的View属性设置为lvwSmallIcon，小图标视图模式。
与大图标视图模式有所不同的是，当使用小图标视图模式时需要使用ListView控件的SmallIcons属性建立与ImageList控件的关联，使用ListItem对象的SmallIcon属性指定其图像文件在ImageList控件中的编号。
ListView控件以小图标视图模式显示时如图 131 7所示。

图 131 7 小图标视图模式
将ListView控件的View属性设置为lvwList，以列表视图模式显示，如图 131 8所示。

图 131 8 列表视图模式
将ListView控件的View属性设置为lvwReport，以报表视图模式显示，如图 131 9所示。

图 131 9 报表视图模式

132. 调用非模式窗体

在VBA中显示用户窗体需要使用Show方法，Show方法显示窗体对象，语法如下：

[object.]Show modal

参数object是可选的，对象表达式。如果省略掉object，则将与活动的窗体模块相关联的窗体当作object。
参数modal是可选的，决定窗体是模态的还是非模式的。Modal参数的设置值如表格 132 1所示。
常数 值 描述
vbModal 1 UserForm是模态的，缺省值。
vbModeless 0 UserForm是非模式的。
表格 132 1 modal参数的设置值
当窗体显示时是模态时，用户在使用应用程序的其它部分之前，必须先对其作出响应。在隐藏或卸载窗体之前，后续代码不会被执行。
比如下面的代码，希望在显示窗体的同时给单元格赋值，但因为窗体显示为模态的，在窗体没有关闭之前，给单元格赋值的代码是不会执行的，所以达不到显示窗体的同时给单元格赋值的目的。

Private Sub CommandButton1_Click()Dim i As IntegerColumns(1).ClearContentsUserForm1.Show 0For i = 1 To 1000Cells(i, 1) = iNext
End Sub

只有在窗体显示为非模式时，后续代码才一出现即被执行。模态下是无法操作工作表的，所以应将第4行代码改成如下的代码，才能在显示窗体的同时给单元格赋值，如图 132 1所示。
UserForm1.Show 0

图 132 1 调用非模式窗体

133. 进度条的制作

如果程序执行时间较长，使用进度条能让用户知道程序执行到何种程度，大约需等待多长时间，可以使界面显得友好。
133-1 使用进度条控件
使用窗体加进度条控件（ProgressBar）制作进度条是最常用的方法。
在VBE窗口中单击菜单“插入”→“用户窗体”，在窗体上添加一个进度条控件，调整为合适的大小，如图 133 1所示。

图 133 1 使用ProgressBar控件
在工作表中添加一个命令按钮，双击后写入下面的代码。

Private Sub CommandButton1_Click()Dim i As IntegerUserForm1.Show 0With UserForm1.ProgressBar1.Min = 1.Max = 10000.Scrolling = 0For i = 1 To 10000Cells(i, 1) = i.Value = iUserForm1.Caption = "正在运行,已完成" & i / 100 & "%,请稍候!"NextEnd WithUnload UserForm1Columns(1).ClearContents
End Sub

代码解析：
工作表中命令按钮的单击事件，在给工作表A1到A10000单元格赋值的同时使用进度条显示其运行速度。
第3行代码，使用Show方法显示进度条控件所在的窗体，并且设置为无模式显示，请参阅技巧132 。
第5、6行代码，设置进度条控件的最小值和最大值，应与第8行代码中的循环计数器的start参数和End参数相一致。
第7行代码，设置进度条控件显示为有间隔的。如果将Scrolling属性设置为1则显示为无间隔的。
第9行代码，在单元格中进行无意义的填充数据以演示进度条。在实际应用中可以将进度条嵌入到程序的循环中。
第11行代码，在窗体的标题栏中显示已完成的百分比。
第14行代码，使用Unload 语句卸载窗体。
Unload 语句从内存中删除一个对象，语法如下：

Unload object

参数object参数是必需的，一个有效的对象。
第19行代码，清空A列填充的数据。
单击工作表中的命令按钮，填充单元格并显示进度条，如图 133 2所示。

图 133 2 ProgressBar进度条
133-2 使用标签控件
在窗体中使用标签可以制作双色的进度条。
步骤1，在VBE窗口中单击菜单“插入”→“用户窗体”，在窗体上添加一个框架控件，在框架控件中添加两个标签控件。
步骤2，在控件的属性窗口中将框架的BackColor 属性设为&H000000FF&，使框架的背景色为红色。将标签1的BackColor属性设为&H0000C000&，使标签1的背景色为绿色。将标签2的BackStyle属性设为fmBackStyleTransparent，使标签2的背景为透明，并把它们的Caption属性全部设置为空白。
步骤3，将窗体和控件调整为合适的大小，如图 133 3所示。

图 133 3 制作标签进度条
步骤4，在VBE中双击窗体，写入下面的代码。

Private Declare Function DrawMenuBar Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const GWL_STYLE As Long = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Const WS_CAPTION As Long = &HC00000
Private Sub UserForm_Initialize()Dim IStyle As LongDim Hwnd As LongIf Val(Application.Version) < 9 ThenHwnd = FindWindow("ThunderXFrame", Me.Caption)ElseHwnd = FindWindow("ThunderDFrame", Me.Caption)End IfIStyle = GetWindowLong(Hwnd, GWL_STYLE)IStyle = IStyle And Not WS_CAPTIONSetWindowLong Hwnd, GWL_STYLE, IStyleDrawMenuBar HwndUserForm1.Height = 28
End Sub

代码解析：
窗体的初始化事件，在窗体加载时使用API函数去除其标题栏。
第1行到第7行代码，API函数的声明。
第11行到第15行代码，获取窗口句柄。
第16行到第19行代码，去除窗体标题栏。
第20行代码，设置窗体的高度。
步骤5，在工作表中添加一个命令按钮，双击后写入下面的代码。

Private Sub CommandButton1_Click()Dim n As IntegerDim i As Integern = 10000With UserForm1.Show 0For i = 1 To nCells(i, 1) = i.Label1.Width = i / n * .Frame1.Width.Label2.Caption = "已完成" & Round(i / n * 100, 0) & "%".Label2.Left = .Label1.Width - 50DoEventsNextEnd WithUnload UserForm1Range("A1:A" & n).ClearContents
End Sub

代码解析：
工作表中命令按钮的单击事件，在给工作表A1到A10000单元格赋值的同时使用进度条显示其运行速度。
第4行代码，设置循环最大值，可根据实际需要设置。
第6行代码，使用Show方法显示窗体，并且设置为无模式的。
第8行代码，在单元格中进行无意义的填充数据以演示进度条。
第9行代码，根据程序运行程度动态设置标签1的宽度，使之达到进度条的效果。
第10行代码，标签2显示已完成百分比。
第11行代码，根据标签1的宽度动态设置标签2的Left属性，使已完成百分比跟随标签1移动。
第12行代码，使用DoEvents函数转让控制权。DoEvents函数将控制权传给操作系统。当操作系统处理完队列中的事件，并且在 SendKeys队列中的所有键也都已送出之后，返回控制权。如果不使用DoEvents函数转让控制权，进度条不能正常显示。
第15行代码，使用Unload 语句卸载窗体。
单击工作表中的命令按钮，填充单元格并显示进度条，如图 133 4所示。

图 133 4 标签进度条

134. 使用TreeView控件显示层次

TreeView控件是一个树形结构的控件，该控件用于显示分层数据，如目录或文件目录，使程序的表现更为灵活，用户的操作更加方便，示例代码如下：

Private Sub UserForm_Initialize()Dim c As IntegerDim r As IntegerDim rng As Variantrng = Sheet1.UsedRangeWith Me.TreeView1.Style = tvwTreelinesPlusMinusPictureText.LineStyle = tvwRootLines.CheckBoxes = FalseWith .Nodes.Clear.Add Key:="科目", Text:="科目名称"For c = 1 To Sheet1.UsedRange.Columns.CountFor r = 2 To Sheet1.UsedRange.Rows.CountIf Not IsEmpty(rng(r, c)) ThenIf c = 1 Then.Add relative:="科目", relationship:=tvwChild, Key:=rng(r, c), Text:=rng(r, c)ElseIf Not IsEmpty(rng(r, c - 1)) Then.Add relative:=rng(r, c - 1), relationship:=tvwChild, Key:=rng(r, c), Text:=rng(r, c)Else.Add relative:=CStr(Sheet1.Cells(r, c - 1).End(xlUp)), relationship:=tvwChild, Key:=rng(r, c), Text:=rng(r, c)End IfEnd IfNextNextEnd WithEnd With
End Sub

代码解析：
在窗体初始化时将工作表中的科目名称填充TreeView控件。
第7行代码，设置TreeView控件每个列表的组成方式。Style属性设置值如表格 131 2所示。
常量 值 描述
tvwTextOnly 0 文本
tvwPictureText 1 图像文本
tvwPlusMinusText 2 符号文本
tvwTreelinesText 4 直线文本
tvwTreelinesPlusMinusPictureText 7 正常显示
表格 134 1 Style属性设置值
第8行代码，设置TreeView控件显示根节点连线。TreeView控件的LineStyle属性设置为tvwRootLines显示根节点连线，设置为tvwTreeLines则隐藏根节点连线。
第9行代码，设置TreeView控件不显示复选框。
第10行代码使用Nodes属性返回对TreeView控件的Node对象的集合的引用。
第11行代码，清除TreeView控件所有的节点。
第12行代码，使用Add方法在Treeview控件的Nodes集合中添加一个Node对象。，Add方法语法如下：
object.Add(relative, relationship, key, text, image, selectedimage)
参数Object是必需的，一个有效的对象。
参数Relative是可选的，代表已存在的Node对象的索引号或键值。
参数relationship是可选的，代表新节点与已存在的节点间的关系，指定的Node对象的相对位置。relationship的设置值如表格 134 2所示。
常量 值 说明
tvwFirst 0 首节点，该Node和在relative中被命名的节点位于同一层，并位于所有同层节点之前。
tvwLast 1 最后的节点，该Node和在relative中被命名的节点位于同一层，并位于所有同层节点之后。任何连续地添加的节点可能位于最后添加的节点之后。
tvwNext 2 下一个节点，该Node位于在relative中被命名的节点之后。
tvwPrevious 3 前一个节点，该Node位于在relative中被命名的节点之前。
tvwChild 4 子节点。该Node 为在relative中被命名的节点的子节点。
表格 134 2 relationship的设置值
参数key是可选的，唯一的字符串，可用于用Item方法检索Node。
参数text 是必需的，在Node中出现的字符串。
参数image是可选的，代表一个图像或在ImageList控件中图象的索引。
参数selectedimage是可选的，代表一个图像或在ImageList控件中图象的索引，在 Node被选中时显示。
第13行到第25行代码代，在根节点下添加子节点。添加子节点仍然使用Add方法，需要一个唯一的Key值，必须提供根节点的Key值（参数relative）和参数relationship值（tvwChild）。要将子节点链接到根节点的下面，参数relative必须与根节点的Key值一致，参数relationship必须设置为tvwchild。要使子节点有效，子节点必须也有自已唯一的Key值。
获得双击TreeView控件后的返回值的代码如下：

Private Sub TreeView1_DblClick()If TreeView1.SelectedItem.Children = 0 ThenSheet1.Range("A65536").End(xlUp).Offset(1) = TreeView1.SelectedItem.TextElseMsgBox "所选择的不是末级科目,请重新选择科目!"End If
End Sub

代码解析：
TreeView1_ DblClick过程是TreeView控件的双击事件，将所选的科目名称写入到工作表中。
第2行代码判断所选节点是否是末级科目。TreeView控件的SelectedItem属性返回当前所选择的节点，而Children属性检查所选节点是否还有子节点，如没有子节点则返回0。
运行窗体效果如图 134 1所示。

图 134 1 使用TreeView控件显示层次

135. 用户窗体添加图标

窗体在显示时标题栏上是没有图标的，如果希望在窗体上添加图标，可以借助API函数在窗体显示时添加自定义的图标。
在VBE窗口中单击菜单“插入”→“用户窗体”，插入一个窗体，在窗体中添加一个Image控件，设置Image控件Picture属性为自定义图标的位图，并将Image控件的Visible属性设置为False，使窗体运行时隐藏Image控件，如图 135 1所示。

图 135 1 窗体中添加Image控件
在VBE中双击窗体，写入下面的代码。

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&
Sub ChangeIcon(ByVal hWnd As Long, Optional ByVal hicon As Long = 0&)SendMessage hWnd, WM_SETICON, ICON_SMALL, ByVal hiconSendMessage hWnd, WM_SETICON, ICON_BIG, ByVal hiconDrawMenuBar hWnd
End Sub
Private Sub UserForm_Initialize()Dim hWnd As LonghWnd = FindWindow(vbNullString, Me.Caption)Call ChangeIcon(hWnd, Image1.Picture.Handle)
End Sub

代码解析：
窗体的初始化事件，窗体在显示时运行ChangeIcon函数，在标题栏中添加图标。
第1行到第6行代码， API函数声明。
第7行到第11行代码，ChangeIcon过程，用于转换图标。
第14行代码，获得窗口句柄。
第15行代码，运行ChangeIcon过程，将Image控件中的位图显示在窗体的标题栏上。
运行窗体后，在窗体标题栏上添加图标，如图 135 2所示。

图 135 2 在窗体标题栏中添加图标

136. 用户窗体添加最大最小化按纽

VBA中的窗体标题栏上只有关闭按纽，没有最大最小化按纽的，可以使用API函数在窗体的标题栏上添加最大最小化按纽，如下面的代码所示。

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const GWL_STYLE = (-16)
Private Sub UserForm_Initialize()Dim hWndForm As LongDim iStyle As LonghWndForm = FindWindow("ThunderDFrame", Me.Caption)iStyle = GetWindowLong(hWndForm, GWL_STYLE)iStyle = iStyle Or WS_MINIMIZEBOXiStyle = iStyle Or WS_MAXIMIZEBOXSetWindowLong hWndForm, GWL_STYLE, iStyle
End Sub

代码解析：
窗体初始化时使用API函数在标题栏上添加最大最小化按纽。
第1行到第6行代码，API函数声明。
第10行代码，获取窗口句柄。
第11行到第14行代码，在标题栏上添加最大最小化按纽。
运行窗体后效果如图 136 1所示。

图 136 1 标题栏上添加最大最小化按纽

137. 禁用窗体标题栏的关闭按钮

如果不希望用户通过窗体标题栏的关闭命令来关闭窗体，可以禁用窗体标题栏上的关闭按钮，如下面的代码所示。

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)If CloseMode <> 1 ThenCancel = TrueMsgBox "请点击按钮关闭窗体!"End If
End Sub

代码解析：
窗体的QueryClose事件，禁用窗体标题栏上的关闭按钮。
窗体的QueryClose事件发生在窗体关闭之前，语法如下：

Private Sub UserForm_QueryClose(cancel As Integer, closemode As Integer)

参数Cance是可选的，整数。将此参数设置成 0 以外的任意值，在所有加载的用户窗体中停止QueryClose事件，并防止关闭窗体与应用程序。
参数closemode是可选的，一个值或常数，用来指示引起QueryClose事件的原因。
closemode参数的设置值如表格 137 1所示。

常数	值	描述
vbFormControlMenu	0	用户在 UserForm上选择“控制”菜单中的“关闭”命令
VbFormCode	1	由代码调用 Unload 语句
vbAppWindows	2	正在结束当前 Windows 操作环境的过程。(仅用于Visual Basic 5.0 )
vbAppTaskManager	3	Windows 的“任务管理器”正在关闭这个应用。(仅用于Visual Basic 5.0 )

表格 137 1 closemode 参数
第2、3行代码，如果窗体不是由代码调用Unload语句关闭，则停止关闭过程，从而禁用窗体标题栏的关闭按钮。
需要注意的是，一定要在窗体上设置关闭窗体的途径，否则会使窗体无法关闭。
窗体运行后，禁用窗体上的关闭按钮关闭窗体，只能使用按钮关闭窗体，如图 137 1所示。

图 137 1 禁用窗体标题栏的关闭命令

138. 屏蔽窗体标题栏的关闭按钮

使用API函数可以屏蔽窗体标题栏的关闭按钮，如下面的代码所示。

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal Hwnd As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_SYSMENU = &H80000
Private Hwnd As Long
Private Sub UserForm_Initialize()Dim Istype As LongHwnd = FindWindow("ThunderDFrame", Me.Caption)Istype = GetWindowLong(Hwnd, GWL_STYLE)Istype = Istype And Not WS_SYSMENUSetWindowLong Hwnd, GWL_STYLE, IstypeDrawMenuBar Hwnd
End Sub

代码解析：
第1行到第7行代码是API函数声明。
第8行到第15行代码是窗体的Initialize事件，当窗体显示时屏蔽窗体标题栏的关闭按钮。
窗体运行后，屏蔽窗体上的关闭按钮，只能使用按钮关闭窗体，如图 138 1所示。

图 138 1 屏蔽窗体标题栏的关闭按钮

139. 无标题栏和边框的窗体

如果希望制作无标题栏和边框的窗体，那么可以使用API函数。
在VBE窗口中单击菜单“插入”→“用户窗体”，双击窗体，在其代码窗口中输入下面的代码：

Private Declare Function DrawMenuBar Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const GWL_STYLE As Long = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_EX_DLGMODALFRAME = &H1&
Private Sub UserForm_Initialize()Dim IStyle As LongDim Hwnd As LongIf Val(Application.Version) < 9 ThenHwnd = FindWindow("ThunderXFrame", Me.Caption)ElseHwnd = FindWindow("ThunderDFrame", Me.Caption)End IfIStyle = GetWindowLong(Hwnd, GWL_STYLE)IStyle = IStyle And Not WS_CAPTIONSetWindowLong Hwnd, GWL_STYLE, IStyleDrawMenuBar HwndIStyle = GetWindowLong(Hwnd, GWL_EXSTYLE) And Not WS_EX_DLGMODALFRAMESetWindowLong Hwnd, GWL_EXSTYLE, IStyle
End Sub
Private Sub UserForm_Click()Unload Me
End Sub

代码解析：
窗体初始化时使用API函数去除其标题栏和边框。
第1行到第8行代码，API函数的声明。
第12行到第16行代码，获取窗口句柄。
第17行到第20行代码，去除窗体标题栏。
第21、22行代码，去除窗体边框。
第24行到第26行代码，窗体的单击事件，单击窗体后关闭该窗体。
窗体运行后如图 139 1所示，单击后关闭该窗体。

图 139 1 无标题栏和边框的窗体

140. 制作年月选择窗体

在工作表中需要输入日期时，可以使用日期时间控件（Microsoft Date and Time Picker Control 6.0，简称DTP控件），请参阅技巧116 。但有时只需要输入年份和月份，使用DTP 控件选择月份并不方便，此时可以使用文本框结合微调框做一个年月选择窗体供用户输入年份和月份。

• 步骤1：在VBE 窗口中单击菜单“插入”→“用户窗体”，将窗体的Caption属性设置为“请选择年月”。
• 步骤2：在窗体上添加一个框架控件和两个命令按纽控件。在框架控件中添加两个文本框控件和两个SpinButton 控件，并把命令按纽的Caption 属性分别设置为“确定”和“取消”。
• 步骤3：调整好控件位置，双击窗体写入下面的代码。

Private Sub UserForm_Initialize()'设置微调框1的初始值为当前年份。SpinButton1.Value = Year(Date)'设置微调框2的初始值为当前月份。SpinButton2.Value = Month(Date)'设置文本框1显示的文本为当前年份。TextBox1.Text = Year(Date) & "年"'设置文本框2显示的文本为当前月份。TextBox2.Text = Month(Date) & "月份"
End Sub
'微调框1的Change事件过程。当单击微调框1数值调节钮的向上键或向下键调节年份时，文本框1显示的年份等于调节后的年份。
Private Sub SpinButton1_Change()TextBox1.Text = SpinButton1.Value & "年"
End Sub
'微调框2的Change事件过程。当单击微调框2数值调节钮的向上键或向下键调节月份时，文本框2显示的月份等于调节后的月份。如果是一年以内的调节，只调节文本框2显示的月份，否则还需要调节文本框1显示的年份。
Private Sub SpinButton2_Change()With SpinButton2Select Case .ValueCase 1 To 12TextBox2.Text = .Value & "月份"Case Is > 12TextBox1.Text = Left(TextBox1.Text, 4) + 1 & "年".Value = 1Case Is < 1TextBox1.Text = Left(TextBox1.Text, 4) - 1 & "年".Value = 12End SelectEnd With
End Sub
Private Sub CommandButton1_Click()
'“确定”按钮的单击过程，将选择好的年月写入工作表中。Sheet1.Range("A65536").End(xlUp).Offset(1) = TextBox1.Text & TextBox2.Text
End Sub
Private Sub CommandButton2_Click()
'使用Unload 语句卸载窗体。Unload Me
End Sub

代码解析：
第1行到第6行代码，窗体的初始化事件，在窗体加载时设置文本框和微调框的初始值。
Year函数返回年份的整数，语法如下：

Year(date)

• 参数date：必需的，可以是任何能够表示日期的Variant、数值表达式、字符串表达式或它们的组合。
  Month函数返回值为1到12之间的整数，表示一年中的某月，语法如下：

Month(date)

• 参数date与Year函数的参数date相同。

运行窗体后效果如图 140 1所示。

图 140 1 年月选择窗体

141. 自定义窗体中的鼠标指针类型

使用对象的MousePointer属性可以自定义鼠标掠过窗体控件时的指针类型，如下面的代码所示。

Private Sub UserForm_Initialize()With Me.TextBox1'设置文本框的MousePointer属性。.MousePointer = 99.MouseIcon = LoadPicture(ThisWorkbook.Path & "\myMouse.ico")End With
End Sub

代码解析：
当用户把鼠标放到窗体的文本框上时，所显示的鼠标指针的类型为自定义图标。
MousePointer属性指定当用户把鼠标放到特定对象上时，所显示鼠标指针的类型，语法如下：

object.MousePointer [= fmMousePointer]

• 参数 object：必需的，一个有效对象。
• 参数 fmMousePointer：可选的，所需鼠标指针的形状。fmMousePointer的设置值如表所示。

常量	值	说明
fmMousePointerDefault	0	标准指针。根据对象来决定指针的图像（默认）
fmMousePointerArrow	1	箭头
fmMousePointerCross	2	十字线指针
fmMousePointerIBeam	3	I 形标
fmMousePointerSizeNESW	6	斜下的双箭头
fmMousePointerSizeNS	7	南北向的双箭头
mMousePointerSizeNWSE	8	斜上的双箭头
fmMousePointerSizeWE	9	东西向的双箭头
fmMousePointerUpArrow	10	向上键
fmMousePointerHourglass	11	沙漏
fmMousePointerNoDrop	12	在被拖动的对象上有 “Not”符号（有一条斜线的圆）。表示是无效的放置目标。
fmMousePointerAppStarting	13	带沙漏的箭头
fmMousePointerHelp	14	带问号的箭头
fmMousePointerSizeAll	15	调整所有尺寸的光标（四向箭头）
fmMousePointerCustom	99	使用由MouseIcon属性指定的图标

第3行代码将文本框的MousePointer属性设置为99，使用由MouseIcon属性指定的自定义图标。MouseIcon属性为对象指定一个自定义的图标，语法如下：

object.MouseIcon = LoadPicture( pathname )

• 参数object：必需的，一个有效的对象。
• 参数pathname：必需的，指定包含自定义图标的文件的路径和文件名。
  设置后的鼠标指针的形状如图 141 1所示。

图 141 1 自定义鼠标指针类型

142. 调整窗体的显示位置

用户窗体显示时，默认的位置是窗体所在Excel文件的中央。如果需要调整，可以在窗体加载时对其进行设置，如下面的代码所示。

Private Sub UserForm_Initialize()With Me'将窗体的StartUpPosition属性设置成手动。.StartUpPosition = 0'设置窗体的Left属性和Top属性，使其加载时显示在屏幕的右下角。.Left = 500.Top = 300End With
End Sub

代码解析：
窗体的初始化事件，在窗体加载时设置其显示位置。

StartUpPosition属性返回或设置一个值，用来指定窗体第一次出现时的位置，设置值如表格所示。

设置	值	描述
手动	0	没有初始设置指定
所有者中心	1	在 UserForm 所属项目的中央
屏幕中心	2	在整个屏幕的中央
窗口缺省	3	在屏幕的左上角

StartUpPosition属性可以在程序中设置，也可以在窗体的属性窗口中设置。

经过设置后的窗体加载时显示位置如图 142 1所示。

图 142 1 调整窗体的显示位置

143. 由鼠标确定窗体显示位置

窗体加载时其显示位置还可以由鼠标的坐标来确定，如下面的代码所示。

Private Sub CommandButton1_Click()Dim ActiveCellX As IntegerDim ActiveCellY As Integer'使用GET.CELL(44) 宏函数取得鼠标的X坐标ActiveCellX = ExecuteExcel4Macro("GET.CELL(44)")'使用GET.CELL(43) 宏函数取得鼠标的Y坐标。ActiveCellY = ExecuteExcel4Macro("GET.CELL(43)")'显示窗体并设置其Top属性和Left属性，调整其显示的位置。With UserForm1.Show 0.Top = ActiveCellY.Left = ActiveCellXEnd With
End Sub

代码解析：
使用ExecuteExcel4Macro 方法执行Microsoft Excel 4.0 宏函数取得鼠标的坐标，ExecuteExcel4Macro方法的语法如下：

expression.ExecuteExcel4Macro(String)

• expression参数：可选的，返回一个Application对象。
• String参数：必需的，一个不带等号的Microsoft Excel 4.0宏语言函数。

还可以利用工作表SelectionChange事件的Target参数取得鼠标的坐标，如下面的代码所示。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)With UserForm1.Show 0.Top = Target.Top.Left = Target.LeftEnd With
End Sub

代码解析：
工作表的SelectionChange事件过程，Target参数代表新选定的区域，返回一个Range对象，在显示窗体时取得其Top和Left属性后设置窗体显示的Top和Left属性。

144. 用户窗体的打印

在使用如图 144 1所示的窗体录入数据时，如果需要把窗体打印出来，可以使用PrintForm方法，如下面的代码所示。

图 144 1 录入窗体

Private Sub CommandButton7_Click()Dim myHeight As IntegerApplication.ScreenUpdating = FalseWith UserForm1myHeight = .Height.DTPicker1.Visible = False.Frame1.Visible = False.Height = myHeight - 30.PrintForm.Height = myHeight.DTPicker1.Visible = True.Frame1.Visible = TrueEnd WithApplication.ScreenUpdating = True
End Sub

代码解析：
录入窗体中的“打印”按钮的单击代码，使用PrintForm方法打印窗体。
第5行代码使用变量myHeight记录窗体的Height属性值，以便在第10行代码中恢复窗体原有的高度。
第6、7行代码将窗体中的DTP日历控件和功能按钮的Visible属性设置为False，使之隐藏，这样在打印时就不会被打印出来。
第9行代码使用PrintForm方法打印窗体，PrintForm方法将UserForm对象的图象逐位发送到打印机，语法如下：

object.PrintForm

• 参数object：代表对象表达式，其值为“应用于”列表中的对象。如果省略该参数，则把焦点所在的窗体当做object。
  第11、12行代码重新显示窗体中的DTP日历控件和功能按钮。
  窗体打印后的效果如图 144 2所示。

图 144 2 窗体打印效果

145. 使用自定义颜色设置窗体颜色

在用VBA进行设计时，会发现控件与颜色相关的属性中系统提供可选择的颜色太少。比如窗体的BackColor属性，如果需要把窗体的背景颜色设置为淡蓝色RGB(52,150,203)，可以在窗体初始化过程中对之进行设置，可以实现想要的效果，但是在设计时却不能看到最终效果。
其实窗体的BackColor属性（包括ForeColor以及BorderColor等等这些设置颜色的属性）允许输入一个以十六进制表示的长整型数值，这样在设计时就看到效果。
首先获取所需要的颜色值并以十六进制表示。还以上面的颜色为例，在立即窗口输入“? Hex(RGB(52,150,203))”可得到一个十六进制数据CB9634，然后把光标定位在窗体属性窗口的BackColor属性值中，删除原来的数值后，输入“&HCB9634&”后按键，窗体颜色效果立即就出现了，如图 145 1所示。

图 145 1 在窗体设计时显示自定义颜色

146. 在窗体中显示图表

工作表中的图表是不能直接显示在窗体中的，如果需要在窗体上显示图表，除了使用技巧61 介绍的使用ShowWindow属性将工作表中嵌入的图表显示在独立的窗口中，还可以使用以下的方法。

146.1 使用Export方法

可以把图表以图形格式从工作表中导出，再用窗体上的Image控件把图表显示出来，如下面的代码所示。

Private Sub UserForm_Initialize()Dim Charts As ChartDim cName As StringSet Charts = Sheets("Sheet2").ChartObjects(1).ChartcName = ThisWorkbook.Path & "\Temp.gif"Charts.Export Filename:=cName, FilterName:="GIF"'设置窗体中Image控件的Picture属性为导出文件的完整路径。Image1.Picture = LoadPicture(cName)End Sub

代码解析：
窗体的初始化事件过程，窗体加载时将工作表中的图表显示在窗体中。
第4行到第6行代码，使用Export方法把Sheet2表中的第一个图表导出到工作簿的同一目录下。
Export方法以图形格式导出图表，语法如下：

expression.Export(Filename, FilterName, Interactive)

• 参数expression：必需的，一个有效的对象。
• 参数Filename：必需的，导出的文件的名称。
  本例中设置Filename参数时加上了导出路径，将图形导出到同一文件夹下。
• 参数FilterName：可选的，导出文件的格式。

Picture 属性指定显示在对象上的位图，语法如下：

object.Picture = LoadPicture( pathname )

• 参数expression：必需的，一个有效的对象。
• 参数pathname：必需的，一个图片文件的完整路径。
  为了使窗体关闭时删除导出的图片文件，在窗体的QueryClose事件中写入下面的代码。

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)Kill ThisWorkbook.Path & "\Temp.gif"
End Sub

代码解析：
窗体关闭时使用Kill方法删除导出的图片文件。Kill方法的语法如下：

Kill pathname

参数Pathname是必需的，用来指定一个文件名的字符串表达式。Pathname参数可以包含目录或文件夹、以及驱动器。
运行窗体，将工作表的图表显示在窗体中

146.2 使用API函数

可以使用API函数把图表从工作表中导出，再用窗体上的Image控件把图表显示出来，如下面的代码所示。

Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As Long, riid As Any, ppvObj As Any) As LongPrivate Declare Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMaxCount As Long) As LongPublic Function LoadShapePicture(shp As Object) As IPictureDispDim nClipsize As LongDim hMem As LongDim lpData As LongDim sdata() As ByteDim fmt As LongDim fmtName As StringDim iClipBoardFormatNumber As LongDim IID_IPicture(15)EmptyClipboardCloseClipboardEnd FunctionPrivate Sub UserForm_Initialize()Image1.Picture = LoadShapePicture(Sheet1.ChartObjects(1))End Sub

代码解析：
第1行到第12行代码API函数声明。
第13行到第60行代码LoadShapePicture函数，导出工作表中的图表。
第61行到第63行代码窗体的初始化事件过程，窗体加载时将工作表中的图表显示在窗体中，如图 146 2所示。关于Image 控件的Picture属性请参阅技巧146-1。

图 146 2 在窗体上显示图表
技巧147 窗体运行时调整控件大小
用户窗体中的控件在运行时是不能调整大小的，而在某些情况下需要在窗体运行时调整控件的大小，此时可以利用控件的MouseMove事件。
步骤1，在VBE窗口中单击菜单“插入”→“用户窗体”，在窗体中添加两个框架控件，在框架控件中间添加一个Image控件，如图 147 1所示。

图 147 1 添加控件
步骤2，Image控件是用来在窗体运行时拖动调整框架控件大小的，所以需要在Image控件的属性窗口将BackStyle属性设置为fmBackStyleTransparent，使控件的背景为透明；将BorderStyle属性设置为fmBorderStyleNone，使控件无可见的边框线；MousePointer属性设置为fmMousePointerSizeWE，当用户把鼠标放到Image控件上时，鼠标指针的类型为东西向的双箭头。关于控件的MousePointer属性请参阅技巧141 中的表格 141 1。
步骤3，在窗体中调整好控件的位置后双击Image控件写入下面的代码：

#001  Dim Abscissa As Single
#002  Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
#003      Abscissa = x
#004  End Sub
#005  Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
#006      If Button = 1 Then
#007          If Abscissa - x > Frame1.Width Or x > Frame2.Width Then Exit Sub
#008          Frame1.Width = Frame1.Width - Abscissa + x
#009          Image1.Left = Image1.Left - Abscissa + x
#010          Frame2.Left = Frame2.Left - Abscissa + x
#011          Frame2.Width = Frame2.Width + Abscissa - x
#012      End If
#013  End Sub

代码解析：
第2行到第4行代码，Image控件的MouseDown事件过程，用户按下鼠标按键时发生，语法如下：
Private Sub object_MouseDown( ByVal Button As fmButton, ByVal Shift As fmShiftState, ByVal X As Single, ByVal Y As Single)
其中参数x是可选的，控件位置的横坐标，以磅为单位，从左边开始测量。
第3行代码将控件的横坐标赋给变量Abscissa。
第5行到第12行代码，Image控件的MouseMove事件过程，用户移动鼠标时该事件发生，语法如下：

Private Sub object_MouseMove( ByVal Button As fmButton, ByVal Shift As fmShiftState, ByVal X As Single, ByVal Y As Single)

其中参数Button是必需的，标识鼠标按键状态的整数值，其设置值如表格 147 1所示。
值 说明 值 说明
0 按键未被按下 4 按下中键
1 按下左键 5 同时按下左键和中键
2 按下右键 6 同时按下中键和右键
3 同时按下左键和右键 7 三个按键全都按下
表格 147 1 Button参数的设置值
参数x是可选的，控件位置的水平坐标，以磅为单位，从左边开始测量。
在MouseMove事件过程中，当用户在窗体上按下左键移动鼠标时，调整两个框架控件的Width属性和框架2的Left属性，使其达到窗体运行时可以进行拖动调整大小的效果。
当鼠标指针在对象上移动时，MouseMove事件是连续发生的，只要鼠标位于对象的边界之内，对象就会不断的识别MouseMove事件，所以框架控件可以连续的进行拖动调整大小。
运行窗体的，选择两个框架控件的中间位置，当鼠标指针变成东西向的双箭头时按下鼠标左键拖动可以进行拖动调整框架控件的大小，如图 147 2所示。

图 147 2 窗体运行时调整控件大