ExcelVBA编程实例(150例)

ExcelVBA编程实例（150例）

主要内容和特点

《ExcelVBA编程入门范例》主要是以一些基础而简短的VBA实例来对ExcelVBA中的常用对象及其属性和方法进行讲解，包括应用程序对象、窗口、工作簿、工作表、单元格和单元格区域、图表、数据透视表、形状、控件、菜单和工具栏、帮助助手、格式化操作、文件操作、以及常用方法和函数及技巧等方面的应用示例。这些例子都比较基础，很容易理解，因而，很容易调试并得以实现，让您通过具体的实例来熟悉ExcelVBA编程。

■ 分16章共14个专题，以具体实例来对大多数常用的ExcelVBA对象进行讲解；

■ 一般而言，每个实例都很简短，用来说明使用VBA实现Excel某一功能的操作；

■ 各章内容主要是实例，即VBA代码，配以简短的说明，有些例子可能配以必要的图片，以便于理解；

■ 您可以对这些实例进行扩充或组合，以实现您想要的功能或更复杂的操作。

VBE编辑器及VBA代码输入和调试的基本知识 在学习这些实例的过程中，最好自已动手将它们输入到VBE编辑器中调试运行，来查看它们的结果。当然，您可以偷赖，将它们复制/粘贴到代码编辑窗口后，进行调试运行。下面，对VBE编辑器界面进行介绍，并对VBA代码输入和调试的基本知识进行简单的讲解。 激活VBE编辑器

一般可以使用以下三种方式来打开VBE编辑器：

■ 使用工作表菜单“工具——宏——Visual Basic编辑器”命令，如图00-01所示； ■ 在Visual Basic工具栏上，按“Visual Basic编辑器”按钮，如图00-02所示； ■ 按Alt+F11组合键。

1

图00-01：选择菜单“工具——宏——Visual Basic编辑器”命令来打开VBE编辑器

图00-02：选择Visual Basic工具栏上的“Visual Basic编辑器”命令按钮来打开VBE编辑器

此外，您也可以使用下面三种方式打开VBE编辑器： ■ 在任一工作表标签上单击鼠标右键，在弹出的菜单中选择“查看代码”，则可进入VBE编辑器访问该工作表的代码模块，如图00-03所示；

■ 在工作簿窗口左上角的Excel图标上单击鼠标右键，在弹出的菜单中选择“查看代码”，则可进入VBE编辑器访问活动工作簿的ThisWorkbook代码模块，如图00-04所示；

■ 选择菜单“工具——宏——宏”命令打开宏对话框，若该工作簿中有宏程序，则单击该对话框中的“编辑”按钮即可进行VBE编辑器代码模块，如图00-05所示。

2

图00-03：右击工作表标签弹出菜单并选择“查看代码”打开VBE编辑器

图00-04：右击Excel图标弹出菜单并选择“查看代码”打开VBE编辑器

图00-05：在宏对话框中单击“编辑”按钮打开VBE编辑器 VBE编辑器窗口简介 刚打开VBE编辑器时，所显示的窗口如图00-06所示，其中没有代码模块窗口。

3

图00-06：刚打开VBE编辑器时的窗口

可以在“工程资源管理器”中双击任一对象打开代码窗口，或者选择菜单“插入——模块”或“插入——类模块”来打开代码窗口。一般VBE编辑器窗口及各组成部件名称如图00-07所示，可以通过“视图”菜单中的菜单项选择所出现的窗口。同时，可以在“工程属性”窗口中设置或修改相应对象的属性。

4

图00-07：VBE编辑器窗口

下面是带有用户窗体的VBE编辑器窗口，如图00-08所示。选择VBE菜单“插入——用户窗体”，即可插入一个用户窗体。当插入用户窗体后，在“工程资源管

5

理器”窗口中会出现一个用户窗体对象，“工程属性”窗口显示当前用户窗体的属性，可对相关属性进行设置或修改。同时，在用户窗体上用鼠标单击，会出现“控件工具箱”。在“工程资源管理器”窗口双击用户窗体图标，会出现相应的用户窗体；在用户窗体图标或者是在用户窗体上单击鼠标右键，然后在弹出的菜单中选择“查看代码”，则会出现用户窗体代码窗口。

图00-08：VBE编辑器窗口(带有用户窗体) 在VBE编辑器中输入VBA代码

6

如前所述，您可以选择VBE菜单“插入——用户窗体/模块/类模块”来插入模块或用户窗体以及相应的代码窗口。此外，您也可以在“工程资源管理器”中单击鼠标右键，从弹出的菜单中选择“插入——用户窗体/模块/类模块”来实现上面的操作。在获取相应的代码模块窗口后，就可以输入VBA代码了。

在VBE编辑器的代码模块中输入VBA代码，通常有以下几种方法： ■ 手工键盘输入；

■ 使用宏录制器，即选择菜单“工具——宏——录制新宏”命令，将所进行的操作自动录制成宏代码；

■ 复制/粘贴代码，即将现有的代码复制后，粘贴到相应的代码模块中；

■ 导入代码模块，即在VBE编辑器中选择菜单“文件——导入文件”或在“工程资源管理器”的任一对象上右击鼠标选择菜单“导入文件”，选择相应的代码文件导入。 如果不想要某个模块了，可以选择菜单“文件——移除模块”，也可以在相应的模块上单击鼠标右键，从弹出的菜单中选择“移除模块”。此时，会弹出一个警告框，询问在移除模块前是否将其导出，可以根据需要进行选择。

也可以选择菜单“文件——导出文件”或在相应的模块上单击鼠标右键后，从弹出的菜单中选择“导出文件”，将移除的模块保存在相应的文件夹中。这样，以后可以对其进行导入，从而加以利用。 调试VBA代码

在VBE编辑器的菜单中，有两项与调试运行有关的菜单项，即“调试”菜单和“运行”菜单，它们提供了各种调试和运行的手段。在我现阶段进行代码调试时，常用到的有以下几个：

■ 逐语句。可以按F8键对代码按顺序一条一条语句运行，从而找出语句或逻辑错误。

■ 设置断点。在可能存在问题的语句处设置断点(可通过在相应代码前的空白部位单击，将会出现一个深红色的椭圆即断点)，当程序运行至断点处时，会中止运行。

■ 在语句的适当部位设置Debug.Print语句，运行后其结果会显示在“立即窗口”中，可以此测试或跟踪变量的值。

■ 在“立即窗口”中测试。对值的测试或跟踪，也可以以“？”开头，在“立即窗口”中输入需要测试值的语句，按Enter回车键后将立即出现结果；对执行语句的测试，可直接在“立即窗口”中输入，按Enter回车键后将执行。 ■ 可以按F5键直接运行光标所在位置的子程序。

在执行程序后，必须在Excel工作表中查看所得到的结果。可以用鼠标单击VBE编辑器左上角的Excel图标或者是按Alt+F11组合键切换到Excel界面。 (当然，对程序代码的调试有很多方法和技巧，留待以后对VBA进一步研究和理解更透彻后一并讨论。) 利用VBA帮助系统

如果遇到疑问或错误，可以利用Excel自带的VBA帮助系统。 ■ 可以在如图00-09所示的部位输入需要帮助的关键词，按Enter回车键后将会出现相关主题。用鼠标单击相应的主题即会出现详细的帮助信息。

图00-09：帮助搜索窗口

■ 可以按F2键，调出“对象浏览器”窗口(如图00-10所示)，在搜索文本框中输入需要帮助的关键词，将会在“搜索结果”中出现一系列相关的对象及方法、属性

7

列表，单击相应的对象则会在“类”和“成员”列表框中显示相应的对象和方法、属性成员列表，在成员列表中相应的项目上按F1键即会出现详细的帮助信息。(“对象浏览器”是一个很好的帮助工具，值得好好研究)

图00-10：对象浏览器窗口

参考资料

《ExcelVBA编程入门范例》参考或引用了以下书籍和资料： (1)Excel 2003高级VBA编程宝典

8

(2)Excel 2003与VBA编程从入门到精通(中文版) (3)巧学巧用Excel 2003 VBA与宏(中文版) (4)ExcelVBA应用程序专业设计实用指南 (5)ExcelVBA应用开发与实例精讲 (6)一些网上资源

更多的信息

关于ExcelVBA的更多参考和学习资源，可以在www.excelhome.net上查找，有疑问也可以在ExcelHome论坛中提问。您也可以登录我的博客http://fanjy.blog.excelhome.net，上面有很多Excel的学习资料。同时，欢迎与我联系交流，我的e-mail是：xhdsxfjy@163.com。

“学习Excel，使用VBA对Excel进行控制操作是我很热衷的业余爱好之一。”——fanjy

第一章 Excel应用程序对象(Application对象)及其常用方法

基本操作应用示例 分类:ExcelVBA>>ExcelVBA编程入门范例 Application对象代表整个Microsoft Excel应用程序，带有175个属性和52个方法，可以设置整个应用程序的环境或配置应用程序。

示例01-01：体验开/关屏幕更新(ScreenUpdating属性) Sub 关闭屏幕更新()

MsgBox \顺序切换工作表Sheet1→Sheet2→Sheet3→Sheet2，先开启屏幕更新，然后关闭屏幕更新\ Worksheets(1).Select

MsgBox \目前屏幕中显示工作表Sheet1\ Application.ScreenUpdating = True Worksheets(2).Select

MsgBox \显示Sheet2了吗？\ Worksheets(3).Select

MsgBox \显示Sheet3了吗？\ Worksheets(2).Select

MsgBox \下面与前面执行的程序代码相同,但关闭屏幕更新功能\ Worksheets(1).Select

MsgBox \目前屏幕中显示工作表Sheet1\& Chr(10) & \关屏屏幕更新功能\ Application.ScreenUpdating = False Worksheets(2).Select

9

MsgBox \显示Sheet2了吗？\ Worksheets(3).Select

MsgBox \显示Sheet3了吗？\ Worksheets(2).Select

Application.ScreenUpdating = True End Sub

示例说明：ScreenUpdating属性用来控制屏幕更新。当运行一个宏程序处理涉及到多个工作表或单元格中的大量数据时，若没有关闭屏幕更新，则会占用CPU的处理时间，从而降低程序的运行速度，而关闭该属性则可显著提高程序运行速度。

示例01-02：使用状态栏(StatusBar属性) Sub testStatusBar()

Application.DisplayStatusBar = True '开启状态栏显示 '赋值状态栏显示的文本

Application.StatusBar = \End Sub

示例说明：StatusBar属性用来指定显示在状态栏上的信息。若不想再显示状态栏文本，可使用Application.StatusBar = False语句关闭状态栏显示，也可以在程序开始将原先的状态栏设置存储，如使用语句oldStatusBar = Application.DisplayStatusBar将状态栏原来的信息存储在变量oldStatusBar，在程序运行完成或退出时，将变量重新赋值给状态栏，如使用语句Application.DisplayStatusBar = oldStatusBar，以恢复状态栏原状。

示例01-03：处理光标(Cursor属性) Sub ViewCursors()

Application.Cursor = xlNorthwestArrow

MsgBox \您将使用箭头光标,切换到Excel界面查看光标形状\ Application.Cursor = xlIBeam

MsgBox \您将使用工形光标,切换到Excel界面查看光标形状\ Application.Cursor = xlWait

MsgBox \您将使用等待形光标,切换到Excel界面查看光标形状\ Application.Cursor = xlDefault

MsgBox \您已将光标恢复为缺省状态\End Sub

示例01-04：获取系统信息 Sub GetSystemInfo()

MsgBox \版本信息为:\& Application.CalculationVersion

MsgBox \当前允许使用的内存为:\& Application.MemoryFree MsgBox \当前已使用的内存为:\& Application.MemoryUsed MsgBox \可以使用的内存为:\& Application.MemoryTotal

MsgBox \本机操作系统的名称和版本为:\& Application.OperatingSystem MsgBox \本产品所登记的组织名为:\& Application.OrganizationName

10

MsgBox \当前用户名为:\& Application.UserName

MsgBox \当前使用的Excel版本为:\& Application.Version End Sub

示例说明：可以使用给UserName属性赋值以设置用户名称。

示例01-05：退出复制/剪切模式(CutCopyMode属性) Sub exitCutCopyMode()

Application.CutCopyMode = False End Sub

示例说明：退出复制/剪切模式后，在程序运行时所进行的复制或剪切操作不会在原单元格区域留下流动的虚框线。需要提醒的是，在程序运行完后，应使用Application.CutCopyMode = False语句恢复该属性的默认设置。

示例01-06：禁止弹出警告信息(DisplayAlerts属性) Sub testAlertsDisplay()

Application.DisplayAlerts = False End Sub 示例说明：在程序运行过程中，有时由于Excel本身设置的原因，会弹出对话框，从而中断程序的运行，您可以在程序之前加上Application.DisplayAlerts = False语句以禁止弹出这些对话框而不影响程序正常运行。需要注意的是，在程序运行结束前，应使DisplayAlerts属性恢复为缺省状态，即使用语句Application.DisplayAlerts = True。该属性的默认设置为True，当将该属性设置为False时，Excel会使直接使用对话框中默认的选择，从而不会因为弹出对话框而影响程序运行。

示例01-07：将Excel全屏幕显示 Sub testFullScreen()

MsgBox \运行后将Excel的显示模式设置为全屏幕\ Application.DisplayFullScreen = True MsgBox \恢复为原来的状态\

Application.DisplayFullScreen = False End Sub

示例01-08：Excel启动的文件夹路径 Sub ExcelStartfolder()

MsgBox \启动的文件夹路径为：\& Chr(10) & Application.StartupPath

End Sub

示例01-09：打开最近使用过的文档 Sub OpenRecentFiles()

MsgBox \显示最近使用过的第三个文件名,并打开该文件\

MsgBox \最近使用的第三个文件的名称为:\& Application.RecentFiles(3).Name

Application.RecentFiles(3).Open

11

End Sub

示例01-10：打开文件(FindFile方法) Sub FindFileOpen()

On Error Resume Next

MsgBox \请打开文件\vbOKOnly + vbInformation, \打开文件\ If Not Application.FindFile Then

MsgBox \文件未找到\vbOKOnly + vbInformation, \打开失败\ End If End Sub

示例说明：本示例将显示“打开”文件对话框，若用户未打开文件(即点击“取消”按钮)，则会显示“打开失败”信息框。示例中使用了FindFile方法，用来显示“打开”对话框并让用户打开一个文件。如果成功打开一个新文件，则该值为True。如果用户取消了操作并退出该对话框，则该值为False。

示例01-11：文件对话框操作(FileDialog属性) Sub UseFileDialogOpen() Dim lngCount As Long '开启\打开文件\对话框

With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect = True .Show

'显示所选的每个文件的路径

For lngCount = 1 To .SelectedItems.Count MsgBox .SelectedItems(lngCount) Next lngCount End With End Sub 示例说明：本示例显示“打开文件”对话框，当用户在其中选择一个或多个文件后，将依次显示每个文件的路径。其中，FileDialog属性返回打开和保存对话框中一系列对象的集合，您可以对该集合对象的属性进行进一步的设置，如上例中的AllowMultiSelect属性设置为True将允许用户选择多个文件。

示例01-12：保存Excel的工作环境 Sub 保存Excel的工作环境()

MsgBox \将Excel的工作环境保存到D:\\ExcelSample\\中\ Application.SaveWorkspace \End Sub

示例说明：运行本程序后，将工作簿以带后缀名.xlw保存到D盘的ExcelSample文件夹中，生成的文件全名为Sample.xlw。当改变工作簿并保存时，Excel会询问是覆盖原文件还是保存副本。

示例01-13：改变Excel工作簿名字(Caption属性) Sub SetCaption()

12

Application.Caption = \ExcelBook\End Sub

示例说明：运行本程序后，将工作簿左上角Excel图标右侧的“Microsoft Excel”改为“My ExcelBook”。

示例01-14：使用InputBox方法 Sub SampleInputBox() Dim vInput

vInput = InputBox(\请输入用户名:\\获取用户名\Application.UserName) MsgBox \您好!\& vInput & \很高兴能认识您.\vbOKOnly, \打招呼\End Sub

示例01-15：设置页边距(CentimetersToPoints方法) Sub SetLeftMargin()

MsgBox \将工作表Sheet1的左页边距设为5厘米\

Worksheets(\= Application.CentimetersToPoints(5) End Sub

示例01-16：使用Windows的计算器(ActivateMicrosoftApp方法) Sub CallCalculate()

Application.ActivateMicrosoftApp Index:=0 End Sub

示例说明：运行本程序后，将调用Windows的计算器。

示例01-17：在程序中运行另一个宏(Run方法) Sub runOtherMacro()

MsgBox \本程序先选择A1至C6单元格区域后执行DrawLine宏\ ActiveSheet.Range(\ Application.Run \End Sub

示例01-18：在指定的时间执行宏(OnTime方法) Sub AfterTimetoRun()

MsgBox \从现在开始,10秒后执行程序「testFullScreen」\

Application.OnTime Now + TimeValue(\\ End Sub

示例说明：运行本程序后，在10秒后将执行程序testFullScreen。

示例01-19：暂时停止宏运行(Wait方法) Sub Stop5sMacroRun() Dim SetTime As Date

MsgBox \按下「确定」,5秒后执行程序「testFullScreen」\ SetTime = DateAdd(\5, Now())

13

Application.Wait SetTime Call testFullScreen End Sub

示例说明：运行本程序后，按下弹出的提示框中的“确定”按钮，等待5秒后执行另一程序testFullScreen。

示例01-20：按下指定的按键后执行程序(OnKey方法) [示例01-20-1]

Sub PressKeytoRun()

MsgBox \按下Ctrl+D后将执行程序「testFullScreen」\ Application.OnKey \\End Sub

[示例01-20-2] Sub ResetKey()

MsgBox \恢复原来的按键状态\ Application.OnKey \End Sub

示例说明：Onkey方法的作用主要是指定特定的键，当按下指定的键时运行相应的宏程序，或者按下指定的键时，使Excel屏蔽特定的功能。

示例01-21：重新计算工作簿 [示例01-21-1]

Sub CalculateAllWorkbook() Application.Calculate End Sub

示例说明：当工作簿的计算模式被设置为手动模式后，运用Calculate方法可以重新计算所有打开的工作簿、工作簿中特定的工作表或者工作表中指定的单元格区域。

[示例01-21-2]

Sub CalculateFullSample()

If Application.CalculationVersion <> Workbooks(1).CalculationVersion Then

Application.CalculateFull End If End Sub

示例说明：本示例先将当前Microsoft Excel的版本与上次计算该工作簿的Excel版本进行比较，如果两个版本不同，则对所有打开工作簿中的数据进行一次完整计算。其中，CalculationVersion属性返回工作簿的版本信息。

示例01-22：控制函数重新计算(Volatile方法) Function NonStaticRand()

'当工作表中任意单元格重新计算时本函数更新 Application.Volatile True NonStaticRand = Rnd()

14

End Function

示例说明：本示例摸仿Excel中的Rand()函数，当工作表单元格发生变化时，都会重新计算该函数。在例子中，使用了Volatile方法，强制函数进行重新计算，即无论何时重新计算工作表，该函数都会重新计算。

示例01-23：利用工作表函数(WorksheetFunction属性) Sub WorksheetFunctionSample() Dim myRange As Range, answer

Set myRange = Worksheets(\ answer = Application.WorksheetFunction.Min(myRange) MsgBox answer End Sub

示例说明：本示例获取工作表Sheet1中单元格区域A1:C10中的最小值，使用了工作表函数Min()。一般，使用WorksheetFunction属性引用工作表函数，但如果VBA自带有实现相同功能的函数，则直接使用该函数，否则会出现错误。

示例01-24：获取重叠区域(Intersect方法) Sub IntersectRange() Dim rSect As Range

Worksheets(\

Set rSect = Application.Intersect(Range(\Range(\ If rSect Is Nothing Then MsgBox \没有交叉区域\ Else

rSect.Select End If End Sub 示例说明：本示例在工作表Sheet1中选定两个命名区域rg1和rg2的重叠区域，如果所选区域不重叠，则显示一条相应的信息。其中，Intersect方法返回一个Range对象，代表两个或多个范围重叠的矩形区域。

示例01-25：获取路径分隔符(PathSeparator属性) Sub GetPathSeparator()

MsgBox \路径分隔符为\& Application.PathSeparator End Sub

示例说明：本示例使用PathSeparator属性返回路径分隔符(“\\”)。

示例01-26：快速移至指定位置(Goto方法) Sub GotoSample()

Application.Goto Reference:=Worksheets(\_ scroll:=True End Sub 示例说明：本示例运行后，将当前单元格移至工作表Sheet1中的单元格A154。

15

示例01-27：显示内置对话框(Dialogs属性) Sub DialogSample()

Application.Dialogs(xlDialogOpen).Show End Sub

示例说明：本示例显示Excel的“打开”文件对话框。其中，Dialogs属性返回的集合代表所有的Excel内置对话框。

示例01-28：退出Excel(SendKeys方法) Sub SendKeysSample()

Application.SendKeys (\End Sub

示例说明：本示例使用SendKeys方法退出Excel，若未保存，则会弹出提示对话框并让用户作出相应的选择。SendKeys方法的作用是摸拟键盘输入，如例中的“%fx”表示在Excel中同时按下Alt、F和X三个键。

示例01-29：关闭Excel Sub 关闭Excel()

MsgBox \将会关闭\ Application.Quit End Sub

示例说明：运行本程序后，若该工作簿未保存，则会弹出对话框询问是否保存。

=============================

(by fanjy)

第二章 窗口(Window对象)基本操作应用示例(一)

分类:ExcelVBA>>ExcelVBA编程入门范例 Window对象代表一个窗口，约有48个属性和14个方法，能对窗口特性进行设置和操作。Window对象是Windows集合中的成员，对于Application对象来说，Windows集合包含该应用程序中的所有窗口；对于Workbook对象来说，Windows集合只包含指定工作簿中的窗口。下面介绍一些示例，以演示和说明Window对象及其属性和方法的运用。

示例02-01：激活窗口(Activate方法) Sub SelectWindow()

Dim iWin As Long, i As Long, bWin MsgBox \依次切换已打开的窗口\ iWin = Windows.Count

16

MsgBox “您已打开的窗口数量为：” & iWin For i = 1 To iWin Windows(i).Activate

bWin = MsgBox(\您激活了第 \& i & \个窗口，还要继续吗？\vbYesNo) If bWin = vbNo Then Exit Sub Next i End Sub

示例02-02：窗口状态(WindowState属性) [示例02-02-01]

Sub WindowStateTest()

MsgBox \当前活动工作簿窗口将最小化\ Windows(1).WindowState = xlMinimized MsgBox \当前活动工作簿窗口将恢复正常\ Windows(1).WindowState = xlNormal MsgBox \当前活动工作簿窗口将最大化\ Windows(1).WindowState = xlMaximized End Sub

示例说明：使用WindowState属性可以返回或者设置窗口的状态。示例中，常量xlMinimized、xlNormal和xlMaximized分别代表窗口不同状态值，Windows(1)表示当前活动窗口。可以使用Windows(index)来返回单个的Window对象，其中的index为窗口的名称或编号，活动窗口总是Windows(1)。 [示例02-02-02] Sub testWindow()

'测试Excel应用程序窗口状态 MsgBox \应用程序窗口将最大化\

Application.WindowState = xlMaximized Call testWindowState

MsgBox \应用程序窗口将恢复正常\ Application.WindowState = xlNormal MsgBox \应用程序窗口已恢复正常\ '测试活动工作簿窗口状态

MsgBox \当前活动工作簿窗口将最小化\ ActiveWindow.WindowState = xlMinimized Call testWindowState

MsgBox \当前活动工作簿窗口将最大化\ ActiveWindow.WindowState = xlMaximized Call testWindowState

MsgBox \当前活动工作簿窗口将恢复正常\ ActiveWindow.WindowState = xlNormal Call testWindowState

MsgBox \应用程序窗口将最小化\

Application.WindowState = xlMinimized Call testWindowState

17

End Sub

?********************************************************* Sub testWindowState()

Select Case Application.WindowState

Case xlMaximized: MsgBox \应用程序窗口已最大化\ Case xlMinimized: MsgBox \应用程序窗口已最小化\ Case xlNormal:

Select Case ActiveWindow.WindowState

Case xlMaximized: MsgBox \当前活动工作簿窗口已最大化\ Case xlMinimized: MsgBox \当前活动工作簿窗口已最小化\ Case xlNormal: MsgBox \当前活动工作簿窗口已恢复正常\ End Select End Select End Sub

示例说明：本示例有两个程序，其中testWindow()是主程序，调用子程序textWindowState()，演示了应用程序窗口和工作簿窗口的不同状态。当前活动窗口一般代表当前活动工作簿窗口，读者可以在VBE编辑器中按F8键逐语句运行testWindow()程序，观察Excel应用程序及工作簿窗口的不同状态。此外，在子程序中，还运用了嵌套的Select Case结构。 [示例02-02-03]

Sub SheetGradualGrow() Dim x As Integer With ActiveWindow

.WindowState = xlNormal .Top = 1 .Left = 1 .Height = 50 .Width = 50

For x = 50 To Application.UsableHeight .Height = x Next x

For x = 50 To Application.UsableWidth .Width = x Next x

.WindowState = xlMaximized End With End Sub

示例说明：本示例将动态演示工作簿窗口由小到大直至最大化的变化过程。在运行程序时，您可以将VBE窗口缩小，从而在工作簿中查看动态效果，也可以在Excel中选择菜单中的宏命令执行以查看效果。

示例02-03：切换显示工作表元素 [示例02-03-01]

Sub testDisplayHeading()

18

MsgBox “切换显示/隐藏行列标号”

ActiveWindow.DisplayHeadings = Not ActiveWindow.DisplayHeadings End Sub

示例说明：本示例切换是否显示工作表中的行列标号。运行后，工作表中的行标号和列标号将消失；再次运行后，行列标号重新出现，如此反复。您也可以将该属性设置为False，以取消行列标号的显示，如ActiveWindow.DisplayHeadings = False；而将该属性设置为True，则显示行列标号。 [示例02-03-02]

Sub testDisplayGridline()

MsgBox “切换显示/隐藏网格线”

ActiveWindow.DisplayGridlines = Not ActiveWindow.DisplayGridlines End Sub

示例说明：本示例切换是否显示工作表中的网格线。运行后，工作表中的网格线消失，再次运行后，网格线重新出现，如此反复。您也可以将该属性设置为False，以取消网格线显示，如ActiveWindow.DisplayGridlines = False；而将该属性设置为True，则显示网格线。 [示例02-03-03]

Sub DisplayHorizontalScrollBar()

MsgBox “切换显示/隐藏水平滚动条”

ActiveWindow.DisplayHorizontalScrollBar = _ Not ActiveWindow.DisplayHorizontalScrollBar End Sub

示例说明：本示例切换是否显示工作表中的水平滚动条。运行后，工作表中的水平滚动条消失，再次运行后，水平滚动条重新出现，如此反复。您也可以将该属性设置为False，以取消水平滚动条，如ActiveWindow.DisplayHorizontalScrollBar = False；而将该属性设置为True，则显示水平滚动条。 同理，DisplayVerticalScrollBar属性将用来设置垂直滚动条。 [示例02-03-04]

Sub DisplayScrollBar()

MsgBox \切换显示/隐藏水平和垂直滚动条\

Application.DisplayScrollBars = Not (Application.DisplayScrollBars) End Sub

示例说明：本示例切换是否显示工作表中的水平和垂直滚动条。运行后，工作表中的水平和垂直滚动条同时消失，再次运行后，水平和垂直滚动条重新出现，如此反复。您也可以将该属性设置为False，以取消水平和垂直滚动条显示，如Application.DisplayScrollBars= False；而将该属性设置为True，则显示水平和垂直滚动条。

示例02-04：显示公式(DisplayFormulas属性) Sub DisplayFormula()

MsgBox “显示工作表中包含公式的单元格中的公式” ActiveWindow.DisplayFormulas = True End Sub

示例说明：本程序运行后，工作表中含有公式的单元格将显示公式而不是数值。

19

若要显示数值，则将该属性设置为False，或者，如果工作表中的公式显示的是结果数值，则该属性为False。

示例02-05：显示/隐藏工作表标签(DisplayWorkbookTabs属性) Sub testDisplayWorkbookTab() MsgBox “隐藏工作表标签”

ActiveWindow.DisplayWorkbookTabs = False End Sub

示例说明：本程序运行后，工作表标签消失。将该属性设置为True，重新显示工作表标签。

示例02-06：命名活动窗口(Caption属性) Sub testCaption()

MsgBox \当前活动工作簿窗口的名字是:\& ActiveWindow.Caption ActiveWorkbook.Windows(1).Caption = \我的工作簿\

MsgBox \当前活动工作簿窗口的名字是:\& ActiveWindow.Caption End Sub

示例说明：本程序运行后，显示当前活动工作簿窗口原先的名称(即工作簿窗口未处于最大化状态时，出现在窗口顶部标题栏中的文字)，然后设置当前活动工作簿窗口名称，即使用语句ActiveWorkbook.Windows(1).Caption = \我的工作簿\，最后显示当前活动工作簿窗口的新名称。改变窗口的标题并不会改变工作簿的名称。

示例02-07：移动窗口到指定位置(ScrollRow属性和ScrollColumn属性) Sub testScroll()

MsgBox “将当前窗口工作表左上角单元格移至第10行第3列” ActiveWindow.ScrollRow = 10 ActiveWindow.ScrollColumn = 3 End Sub

示例说明：本程序运行后，当前活动窗口左上角单元格为第10行第3列。可以通过设置这两个属性来移动窗口到指定的位置，也可以返回指定窗格或窗口最左上面的行号或列号。

示例02-08：调整窗口(EnableResize属性) Sub testResize()

MsgBox “设置窗口大小不可调整” ActiveWindow.EnableResize = False End Sub

示例说明：测试本程序前，将当前工作簿窗口恢复为正常状态(即让工作簿标题可见)，运行程序后，当前工作簿窗口将不能调整其大小，右上角的最小化最大化按钮将消失(即隐藏最大化和最小化按钮)。该属性设置为True，则能调整窗口大小。

示例02-09：拆分窗格

20

ollingSideBySide属性设置是否将两个窗口的滚动保持同步，如果为True，在对文档进行并排比较的同时启用窗口内容的滚动功能。若为False，则在对文档进行并排比较的同时禁用窗口内容的滚动功能。ResetPositionsSideBySide方法重置正在进行并排比较的两个工作表窗口的位置，例如，如果用户将正在进行比较的两个工作表窗口中的其中一个窗框最小化或最大化，就可以使用ResetPositionsSideBySide方法重置显示，以便这两个窗口再次并排显示。BreakSideBySide方法用来关闭并排比较。

示例02-22：返回或设置窗口中显示的视图(View属性) Sub testView()

MsgBox \将视图切换为分页预览\

ActiveWindow.View = xlPageBreakPreview MsgBox \窗口视图为:\& ActiveWindow.View MsgBox \将视图恢复正常\

ActiveWindow.View = xlNormalView

MsgBox \窗口视图为:\& ActiveWindow.View End Sub

示例02-23：返回窗口中可见单元格区域(VisibleRange属性) Sub testVisibleRange()

MsgBox \当前窗口中共有\& Windows(1).VisibleRange.Cells.Count & \个单元格可见\End Sub

示例说明：如果窗口中有部分行列的单元格可见，也包括在可见单元格区域中。

示例02-24：创建窗口(NewWindow方法) Sub testNewWindow()

MsgBox \为活动窗口创建一个副本\ ActiveWindow.NewWindow

MsgBox \所创建窗口的窗口号为\& ActiveWindow.WindowNumber End Sub

示例说明：本示例中，NewWindow方法为指定窗口(本例中为当前活动窗口)创建一个副本，然后显示该副本窗口的窗口号。注意，窗口号与窗口索引(Index属性)的不同，例如名称为“Book1.xls:2”的窗口，其窗口号为２，而窗口索引为该窗口在Windows集合中的位置，可以为窗口名称或编号。

示例02-25：设置窗口大小(Zoom属性) Sub testWindowDisplaySize()

MsgBox \将窗口大小设置为与选定区域相适应的大小\ ActiveWindow.Zoom = True MsgBox \以双倍大小显示窗口\ ActiveWindow.Zoom = 200 MsgBox \以正常大小显示窗口\ ActiveWindow.Zoom = 100

26

End Sub 示例说明：Zoom属性将以百分数的形式(100表示正常大小，200表示双倍大小，以此类推)返回或设置窗口的显示大小。如果本属性为 True，则可将窗口大小设置成与当前选定区域相适应的大小。本功能仅对窗口中当前的活动工作表起作用，若要对其他工作表使用本属性，必须先激活该工作表。

示例02-26：激活窗口(ActivateNext方法和ActivatePrevious方法) [示例02-26-01]

Sub testActivateWindow1()

MsgBox \若已打开Book1.xls、Book2.xls和Book3.xls三个工作簿且Book1.xls为当前窗口\& Chr(10) & \则按Book3.xls-Book2.xls-Book1.xls依次激活窗口\

ActiveWindow.ActivateNext

MsgBox \激活工作簿:\& Windows(1).Caption ActiveWindow.ActivateNext

MsgBox \激活工作簿:\& Windows(1).Caption ActiveWindow.ActivateNext

MsgBox \激活工作簿:\& Windows(1).Caption End Sub

[示例02-26-02]

Sub testActivateWindow2()

MsgBox \若已打开Book1.xls、Book2.xls和Book3.xls三个工作簿且Book1.xls为当前窗口\& Chr(10) & \则按Book2.xls-Book3.xls-Book1.xls依次激活窗口\

ActiveWindow.ActivatePrevious

MsgBox \激活工作簿:\& Windows(1).Caption ActiveWindow.ActivatePrevious

MsgBox \激活工作簿:\& Windows(1).Caption ActiveWindow.ActivatePrevious

MsgBox \激活工作簿:\& Windows(1).Caption End Sub

示例02-27：滚动窗口(LargeScroll方法和SmallScroll方法) [示例02-27-01] Sub testScroll1()

MsgBox \将当前窗口向下滚动3页并向右滚动1页\ ActiveWindow.LargeScroll Down:=3, ToRight:=1 End Sub

示例说明：LargeScroll方法将按页滚动窗口的内容，其语法为expression.LargeScroll(Down, Up, ToRight, ToLeft)，带有4个可选的参数，其中参数Down表示将窗口内容向下滚动的页数；参数Up表示将窗口内容向上滚动的页数；参数ToRight表示将窗口内容向右滚动的页数；参数ToLeft表示将窗口内容向左滚动的页数。如果同时指定了Down和Up，窗口内容上下方向滚动的页数由这两个参数的差决定，例如，如果Down为3，Up为6，则窗口向上滚动三页。

27

如果同时指定了ToLeft和ToRight，窗口内容左右方向滚动的页数由这两个参数的差决定，例如，如果ToLeft为3，ToRight为 6，则窗口向右滚动三页。所有这四个参数都可以使用负数。 [示例02-27-02] Sub testScroll2()

MsgBox \将当前活动窗口向下滚动3行\ ActiveWindow.SmallScroll down:=3 End Sub

示例说明：SmallScroll方法按行或列滚动窗口，其语法为expression.SmallScroll(Down, Up, ToRight, ToLeft)，带有4个可选的参数，其中参数Down表示将窗口内容向下滚动的行数；参数Up表示将窗口内容向上滚动的列数；参数ToRight表示将窗口内容向右滚动的列数；参数ToLeft表示将窗口内容向左滚动的列数。如果同时指定了Down和Up，则窗口内容滚动的行数由这两个参数的差值决定，例如，如果Down为3，Up为6，则窗口内容向上滚动三行。如果同时指定了ToLeft和ToRight，则窗口内容滚动的列数由这两个参数的差值决定，例如，如果ToLeft为3，ToRight为 6，则窗口内容向右滚动三列。以上四个参数均可取负值。

示例02-28：测试所选单元格宽度和高度 Sub testWidthOrHeight()

Dim lWinWidth As Long, lWinHeight As Long With ActiveWindow

lWinWidth = .PointsToScreenPixelsX(.Selection.Width) lWinHeight = .PointsToScreenPixelsY(.Selection.Height) End With

MsgBox \当前选定单元格宽度为:\& lWinWidth & Chr(10) & _ \当前选定单元格高度为:\& lWinHeight End Sub

示例02-29：关闭窗口(Close方法) Sub CloseWindow()

MsgBox \关闭当前窗口\ ActiveWindow.Close End Sub

示例说明：本示例运行后，将关闭当前窗口。如果当前窗口未保存，则会弹出询问是否保存的消息框供选择。 By fanjy in 2006-9-23

第三章 工作簿(Workbook)基本操作应用示例(一)

分类:ExcelVBA>>ExcelVBA编程入门范例

Workbook对象代表工作簿，而Workbooks集合则包含了当前所有的工作簿。下面对Workbook对象的重要的方法和属性以及其它一些可能涉及到的方法和属性

28

进行示例介绍，同时，后面的示例也深入介绍了一些工作簿对象操作的方法和技巧。

示例03-01：创建工作簿(Add方法) [示例03-01-01]

Sub CreateNewWorkbook1()

MsgBox \将创建一个新工作簿.\ Workbooks.Add End Sub

[示例03-01-02]

Sub CreateNewWorkbook2() Dim wb As Workbook Dim ws As Worksheet Dim i As Long

MsgBox \将创建一个新工作簿,并预设工作表格式.\ Set wb = Workbooks.Add Set ws = wb.Sheets(1) ws.Name = \产品汇总表\ ws.Cells(1, 1) = \序号\

ws.Cells(1, 2) = \产品名称\ ws.Cells(1, 3) = \产品数量\ For i = 2 To 10

ws.Cells(i, 1) = i - 1 Next i End Sub

示例03-02：添加并保存新工作簿 Sub AddSaveAsNewWorkbook() Dim Wk As Workbook

Set Wk = Workbooks.Add

Application.DisplayAlerts = False

Wk.SaveAs Filename:=\End Sub

示例说明：本示例使用了Add方法和SaveAs方法，添加一个新工作簿并将该工作簿以文件名SalesData.xls保存在D盘中。其中，语句Application.DisplayAlerts = False表示禁止弹出警告对话框。

示例03-03：打开工作簿(Open方法) [示例03-03-01]

Sub openWorkbook1()

Workbooks.Open \需打开文件的路径>\\<文件名>\End Sub

示例说明：代码中的<>里的内容需用所需打开的文件的路径及文件名代替。Open方法共有15个参数，其中参数FileName为必需的参数，其余参数可选。

29

[示例03-03-02]

Sub openWorkbook2() Dim fname As String

MsgBox \将D盘中的<测试.xls>工作簿以只读方式打开\ fname = \测试.xls\

Workbooks.Open Filename:=fname, ReadOnly:=True End Sub

示例03-04：将文本文件导入工作簿中(OpenText方法) Sub TextToWorkbook()

'本示例打开某文本文件并将制表符作为分隔符对此文件进行分列处理转换成为工作表

Workbooks.OpenText Filename:=\文本文件所在的路径>/<文本文件名>\ DataType:=xlDelimited, Tab:=True End Sub

示例说明：代码中的<>里的内容需用所载入的文本文件所在路径及文件名代替。OpenText方法的作用是导入一个文本文件，并将其作为包含单个工作表的工作簿进行分列处理，然后在此工作表中放入经过分列处理的文本文件数据。该方法共有18个参数，其中参数FileName为必需的参数，其余参数可选。

示例03-05：保存工作簿(Save方法) [示例03-05-01] Sub SaveWorkbook()

MsgBox \保存当前工作簿.\ ActiveWorkbook.Save End Sub

[示例03-05-02]

Sub SaveAllWorkbook1() Dim wb As Workbook

MsgBox \保存所有打开的工作簿后退出Excel.\ For Each wb In Application.Workbooks wb.Save Next wb

Application.Quit End Sub

[示例03-05-03]

Sub SaveAllWorkbook2() Dim wb As Workbook

For Each wb In Workbooks

If wb.Path <> \ Next wb End Sub

示例说明：本示例保存原来已存在且已打开的工作簿。

30

示例03-06：保存工作簿(SaveAs方法) [示例03-06-01]

Sub SaveWorkbook1()

MsgBox \将工作簿以指定名保存在默认文件夹中.\ ActiveWorkbook.SaveAs \工作簿名>.xls\End Sub

示例说明：SaveAs方法相当于“另存为??”命令，以指定名称保存工作簿。该方法有12个参数，均为可选参数。如果未指定保存的路径，那么将在默认文件夹中保存该工作簿。如果文件夹中该工作簿名已存在，则提示是否替换原工作簿。

[示例03-06-02]

Sub SaveWorkbook2()

Dim oldName As String, newName As String Dim folderName As String, fname As String oldName = ActiveWorkbook.Name newName = \

MsgBox \将<\以<\的名称保存\ folderName = Application.DefaultFilePath fname = folderName & \ ActiveWorkbook.SaveAs fname End Sub 示例说明：本示例将当前工作簿以一个新名(即new加原名)保存在默认文件夹中。 [示例03-06-03] Sub CreateBak1()

MsgBox \保存工作簿并建立备份工作簿\

ActiveWorkbook.SaveAs CreateBackup:=True End Sub

示例说明：本示例将在当前文件夹中建立工作簿的备份。 [示例03-06-04] Sub CreateBak2()

MsgBox \保存工作簿时,若已建立了备份,则将出现包含True的信息框,否则出现False.\

MsgBox ActiveWorkbook.CreateBackup End Sub

示例03-07：取得当前打开的工作簿数(Count属性) Sub WorkbookNum()

MsgBox \当前已打开的工作簿数为:\End Sub

示例03-08：激活工作簿(Activate方法) [示例03-08-01]

Sub ActivateWorkbook1()

Workbooks(\工作簿名>\

31

End Sub

示例说明：Activate方法激活一个工作簿，使该工作簿为当前工作簿。 [示例03-08-02]

Sub ActivateWorkbook2() Dim n As Long, i As Long Dim b As String

MsgBox \依次激活已经打开的工作簿\ n = Workbooks.Count For i = 1 To n

Workbooks(i).Activate

b = MsgBox(\第 \个工作簿被激活，还要继续吗?\ If b = vbNo Then Exit Sub

If i = n Then MsgBox \最后一个工作簿已被激活.\ Next i End Sub

示例03-09：保护工作簿(Protect方法) Sub ProtectWorkbook()

MsgBox \保护工作簿结构,密码为123\

ActiveWorkbook.Protect Password:=\ MsgBox \保护工作簿窗口,密码为123\

ActiveWorkbook.Protect Password:=\ MsgBox \保护工作簿结构和窗口,密码为123\

ActiveWorkbook.Protect Password:=\rue

End Sub

示例说明：使用Protect方法来保护工作簿，带有三个可选参数，参数Password指明保护工作簿密码，要解除工作簿保护应输入此密码；参数Structure设置为True则保护工作簿结构，此时不能对工作簿中的工作表进行插入、复制、删除等操作；参数Windows设置为True则保护工作簿窗口，此时该工作簿右上角的最小化、最大化和关闭按钮消失。

示例03-10：解除工作簿保护(UnProtect方法) Sub UnprotectWorkbook() MsgBox \取消工作簿保护\

ActiveWorkbook.Unprotect \End Sub

示例03-11：工作簿的一些通用属性示例 Sub testGeneralWorkbookInfo()

MsgBox \本工作簿的名称为\

MsgBox \本工作簿带完整路径的名称为\ MsgBox \本工作簿对象的代码名为\ MsgBox \本工作簿的路径为\

32

If ActiveWorkbook.ReadOnly Then

MsgBox \本工作簿已经是以只读方式打开\ Else

MsgBox \本工作簿可读写.\ End If

If ActiveWorkbook.Saved Then MsgBox \本工作簿已保存.\ Else

MsgBox \本工作簿需要保存.\ End If End Sub

示例03-12：访问工作簿的内置属性(BuiltinDocumentProperties属性) [示例03-12-01]

Sub ShowWorkbookProperties() Dim SaveTime As String On Error Resume Next

SaveTime = ActiveWorkbook.BuiltinDocumentProperties(\\

If SaveTime = \

MsgBox ActiveWorkbook.Name & \工作簿未保存.\ Else

MsgBox \本工作簿已于\保存\ End If End Sub

示例说明：在Excel中选择菜单“文件——属性”命令时将会显示一个“属性”对话框，该对话框中包含了当前工作簿的有关信息，可以在VBA中使用BuiltinDocumentProperties属性访问工作簿的属性。上述示例代码将显示当前工作簿保存时的日期和时间。 [示例03-12-02]

Sub listWorkbookProperties() On Error Resume Next

'在名为\工作簿属性\的工作表中添加信息,若该工作表不存在,则新建一个工作表

Worksheets(\工作簿属性\ If Err.Number <> 0 Then

Worksheets.Add after:=Worksheets(Worksheets.Count) ActiveSheet.Name = \工作簿属性\ Else

ActiveSheet.Clear End If

On Error GoTo 0 ListProperties End Sub

33

‘- - - - - - - - - - - - - - - - - - - - - - - Sub ListProperties() Dim i As Long

Cells(1, 1) = \名称\ Cells(1, 2) = \类型\ Cells(1, 3) = \值\

Range(\ With ActiveWorkbook

For i = 1 To .BuiltinDocumentProperties.Count With .BuiltinDocumentProperties(i) Cells(i + 1, 1) = .Name Select Case .Type

Case msoPropertyTypeBoolean Cells(i + 1, 2) = \ Case msoPropertyTypeDate Cells(i + 1, 2) = \ Case msoPropertyTypeFloat Cells(i + 1, 2) = \ Case msoPropertyTypeNumber Cells(i + 1, 2) = \ Case msoPropertyTypeString Cells(i + 1, 2) = \ End Select

On Error Resume Next

Cells(i + 1, 3) = .Value On Error GoTo 0 End With Next i End With

Range(\End Sub

示例说明：本示例代码在“工作簿属性”工作表中列出了当前工作簿中的所有内置属性。

示例03-13：测试工作簿中是否包含指定工作表(Sheets属性) Sub testSheetExists()

MsgBox \测试工作簿中是否存在指定名称的工作表\ Dim b As Boolean

b = SheetExists(\指定的工作表名>\ If b = True Then

MsgBox \该工作表存在于工作簿中.\ Else

MsgBox \工作簿中没有这个工作表.\ End If

34

End Sub

‘- - - - - - - - - - - - - - - - - - - - - - - Private Function SheetExists(sname) As Boolean Dim x As Object

On Error Resume Next

Set x = ActiveWorkbook.Sheets(sname) If Err = 0 Then

SheetExists = True Else

SheetExists = False End If

End Function

示例03-14：对未打开的工作簿进行重命名(Name方法) Sub rename()

Name \工作簿路径>\\<旧名称>.xls\工作簿路径>\\<新名称>.xls\End Sub

示例说明：代码中<>中的内容为需要重命名的工作簿所在路径及新旧名称。该方法只是对未打开的文件进行重命名，如果该文件已经打开，使用该方法会提示错误。

示例03-15：设置数字精度(PrecisionAsDisplayed属性) Sub SetPrecision() Dim pValue

MsgBox \在当前单元格中输入1/3，并将结果算至小数点后两位\ ActiveCell.Value = 1 / 3

ActiveCell.NumberFormatLocal = \ pValue = ActiveCell.Value * 3

MsgBox \当前单元格中的数字乘以3等于：\

MsgBox \然后,将数值分类设置为[数值],即单元格中显示的精度\ ActiveWorkbook.PrecisionAsDisplayed = True pValue = ActiveCell.Value * 3

MsgBox \此时,当前单元格中的数字乘以3等于：\而不是1\ ActiveWorkbook.PrecisionAsDisplayed = False End Sub

示例说明：PrecisionAsDisplayed属性的值设置为True，则表明采用单元格中所显示的数值进行计算。

示例03-16：删除自定义数字格式(DeleteNumberFormat方法) Sub DeleteNumberFormat()

MsgBox \从当前工作簿中删除000-00-0000的数字格式\ ActiveWorkbook.DeleteNumberFormat (\End Sub

示例说明：DeleteNumberFormat方法将从指定的工作簿中删除自定义的数字格

35

式。

示例03-17：控制工作簿中图形显示(DisplatyDrawingObjects属性) Sub testDraw()

MsgBox \隐藏当前工作簿中的所有图形\

ActiveWorkbook.DisplayDrawingObjects = xlHide MsgBox \仅显示当前工作簿中所有图形的占位符\

ActiveWorkbook.DisplayDrawingObjects = xlPlaceholders MsgBox \显示当前工作簿中的所有图形\

ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes End Sub

示例说明：本属性作用的对象包括图表和形状。在应用本示例前，应保证工作簿中有图表或形状，以察看效果。

示例03-18：指定名称(Names属性) Sub testNames()

MsgBox \将当前工作簿中工作表Sheet1内单元格A1命名为myName.\

ActiveWorkbook.Names.Add Name:=\1\

End Sub

示例说明：对于Workbook对象而言，Names属性返回的集合代表工作簿中的所有名称。

示例03-19：检查工作簿的自动恢复功能(EnableAutoRecover属性) Sub UseAutoRecover()

'检查是否工作簿自动恢复功能开启,如果没有则开启该功能 If ActiveWorkbook.EnableAutoRecover = False Then ActiveWorkbook.EnableAutoRecover = True MsgBox \刚开启自动恢复功能.\ Else

MsgBox \自动恢复功能已开启.\ End If End Sub

示例03-20：设置工作簿密码(Password属性) Sub UsePassword() Dim wb As Workbook

Set wb = Application.ActiveWorkbook wb.Password = InputBox(\请输入密码:\ wb.Close End Sub

示例说明：Password属性返回或设置工作簿密码，在打开工作簿时必须输入密码。本示例代码运行后，提示设置密码，然后关闭工作簿；再次打开工作簿时，要求输入密码。

36

示例03-21：返回工作簿用户状态信息(UserStatus属性) Sub UsePassword()

Dim Users As Variant Dim Row As Long

Users = ActiveWorkbook.UserStatus Row = 1

With Workbooks.Add.Sheets(1) .Cells(Row, 1) = \用户名\

.Cells(Row, 2) = \日期和时间\ .Cells(Row, 3) = \使用方式\

For Row = 1 To UBound(Users, 1)

.Cells(Row + 1, 1) = Users(Row, 1) .Cells(Row + 1, 2) = Users(Row, 2) Select Case Users(Row, 3) Case 1

.Cells(Row + 1, 3).Value = \个人工作簿\ Case 2

.Cells(Row + 1, 3).Value = \共享工作簿\ End Select Next End With

Range(\End Sub

示例说明：示例代码运行后，将创建一个新工作簿并带有用户使用当前工作簿的信息，即用户名、打开的日期和时间及工作簿使用方式。

示例03-22：检查工作簿是否有密码保护(HasPassword属性) Sub IsPassword()

If ActiveWorkbook.HasPassword = True Then

MsgBox \本工作簿有密码保护,请在管理员处获取密码.\ Else

MsgBox \本工作簿无密码保护,您可以自由编辑.\ End If End Sub

示例03-23：决定列表边框是否可见(InactiveListBorderVisible属性) Sub HideListBorders()

MsgBox \隐藏当前工作簿中所有非活动列表的边框.\ ActiveWorkbook.InactiveListBorderVisible = False End Sub

示例03-24：关闭工作簿 [示例03-24-01]

37

Sub CloseWorkbook1()

Msgbox “不保存所作的改变而关闭本工作簿” ActiveWorkbook.Close False

‘或ActiveWorkbook.Close SaveChanges:=False ‘或ActiveWorkbook.Saved=True End sub

[示例03-24-02]

Sub CloseWorkbook2()

Msgbox “保存所作的改变并关闭本工作簿” ActiveWorkbook.Close True End sub

[示例03-24-03]

Sub CloseWorkbook3()

Msgbox “关闭本工作簿。如果工作簿已发生变化，则弹出是否保存更改的对话框。”

ActiveWorkbook.Close True End sub

[示例03-24-04] 关闭并保存所有工作簿 Sub CloseAllWorkbooks() Dim Book As Workbook

For Each Book In Workbooks

If Book.Name<>ThisWorkbook.Name Then Book.Close savechanges:=True End If Next Book

ThisWorkbook.Close savechanges:=True End Sub

[示例03-24-05] 关闭工作簿并将它彻底删除 Sub KillMe()

With ThisWorkbook .Saved = True

.ChangeFileAccess Mode:=xlReadOnly Kill .FullName .Close False End With End Sub

[示例03-24-06]关闭所有工作簿，若工作簿已改变则弹出是否保存变化的对话框

Sub closeAllWorkbook()

MsgBox \关闭当前所打开的所有工作簿\ Workbooks.Close End Sub

38

第三章 工作簿(Workbook)基本操作应用示例(二)

分类:ExcelVBA>>ExcelVBA编程入门范例

<其它一些有关操作工作簿的示例> 示例03-25：创建新的工作簿 Sub testNewWorkbook()

MsgBox \创建一个带有10个工作表的新工作簿\Dim wb as Workbook

Set wb = NewWorkbook(10) End Sub

‘- - - - - - - - - - - - - - - - - - - - - - -

Function NewWorkbook(wsCount As Integer) As Workbook

'创建带有由变量wsCount提定数量工作表的工作簿，工作表数在1至255之间 Dim OriginalWorksheetCount As Long Set NewWorkbook = Nothing

If wsCount < 1 Or wsCount > 255 Then Exit Function

OriginalWorksheetCount = Application.SheetsInNewWorkbook Application.SheetsInNewWorkbook = wsCount Set NewWorkbook = Workbooks.Add

Application.SheetsInNewWorkbook = OriginalWorksheetCount End Function

示例说明：自定义函数NewWorkbook可以创建最多带有255个工作表的工作簿。本测试示例创建一个带有10个工作表的新工作簿。

示例03-26：判断工作簿是否存在 Sub testFileExists()

MsgBox \如果文件不存在则用信息框说明,否则打开该文件.\ If Not FileExists(\文件夹\\子文件夹\\文件.xls\ MsgBox \这个工作簿不存在!\ Else

Workbooks.Open \文件夹\\子文件夹\\文件.xls\ End If End Sub

‘- - - - - - - - - - - - - - - - - - - - - - -

Function FileExists(FullFileName As String) As Boolean '如果工作簿存在,则返回True

FileExists = Len(Dir(FullFileName)) > 0 End Function

示例说明：本示例使用自定义函数FileExists判断工作簿是否存在，若该工作簿已存在，则打开它。代码中，“C:\\文件夹\\子文件夹\\文件.xls”代表工作簿所在的文件夹名、子文件夹名和工作簿文件名。

示例03-27：判断工作簿是否已打开

39

[示例03-27-01]

Sub testWorkbookOpen()

MsgBox \如果工作簿未打开,则打开该工作簿.\ If Not WorkbookOpen(\工作簿名.xls\ Workbooks.Open \工作簿名.xls\ End If End Sub

‘- - - - - - - - - - - - - - - - - - - - - - -

Function WorkbookOpen(WorkBookName As String) As Boolean '如果该工作簿已打开则返回真 WorkbookOpen = False

On Error GoTo WorkBookNotOpen

If Len(Application.Workbooks(WorkBookName).Name) > 0 Then WorkbookOpen = True

MsgBox \该工作簿已打开\ Exit Function End If

WorkBookNotOpen: End Function

示例说明：本示例中的函数WorkbookOpen用来判断工作簿是否打开。代码中，“工作簿名.xls”代表所要打开的工作簿名称。 [示例03-27-02]

Sub testWookbookIFOpen() Dim wb As String Dim bwb As Boolean

wb = \要判断的工作簿名称>\ bwb = WorkbookIsOpen(wb) If bwb = True Then

MsgBox \工作簿\已打开.\ Else

MsgBox \工作簿\未打开.\ End If End Sub

‘- - - - - - - - - - - - - - - - - - - - - - - Private Function WorkbookIsOpen(wbname) As Boolean Dim x As Workbook On Error Resume Next

Set x = Workbooks(wbname) If Err = 0 Then

WorkbookIsOpen = True Else

WorkbookIsOpen = False End If

End Function

40

本文来源：https://www.bwwdw.com/article/7tv7.html