VBA常用代码解析（第十九讲）

077 内置对话框

077-1 调用内置的对话框

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

Sub DialogOpen()

Application.Dialogs(xlDialogOpen).Showarg1:=ThisWorkbook.Path & '\*.xls'

End Sub

代码解析：

DialogOpen过程显示内置的“打开”对话框并选定示例所在的文件夹。

显示内置对话框语法如下：

Application.Dialogs(xlDialogConst).Show

Dialogs集合代表所有的内置对话框，每个Dialog对象代表一个内置对话框，不能新建内置对话框或向该集合中添加内置对话框。

参数xlDialogConst是内置对话框的内置常量，每个常量都以“xlDialog”开头，其后是对话框的名称，如“打开”对话框的常量为“xlDialogOpen”。常用内置对话框的内置常量如表格所示。

显示内置对话框使用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过程，显示内置的“打开”对话框，并且直接选定示例所在的文件夹。

077-2 获取选定文件的文件名

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

Sub OpenFilename()

DimFilename As Variant

Dimmymsg As Integer

Dimi As Integer

Filename= Application.GetOpenFilename(Title:='删除文件'，MultiSelect:=True)

If IsArray(Filename)Then

mymsg = MsgBox('是否删除所选文件?'，vbYesNo，'提示')

If mymsg = vbYes Then

For i = 1 To UBound(Filename)

Kill Filename(i)

Next

End If

EndIf

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过程，显示标准的内置“打开”对话框，删除用户选定的文件，如所图示。

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

077-3 使用“另存为”对话框

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

Sub CopyFilename()

DimNowWorkbook As Workbook

DimFileName As String

On ErrorGoTo line

FileName= Application.GetSaveAsFilename _

(InitialFileName:='D:\' &Date & ' ' & ThisWorkbook.Name，_

fileFilter:='Excel files(*.xls)，*.xls，All files (*.*)，*.*'，_

Title:='数据备份')

If FileName<> 'False' Then

Set NowWorkbook = Workbooks.Add

With NowWorkbook

.SaveAs FileName

ThisWorkbook.Sheets('Sheet2').UsedRange.Copy_

.Sheets('Sheet1').Range ('A1')

.Save

End With

GoTo line

EndIf

ExitSub

line:

ActiveWorkbook.Close

End Sub

代码解析：

CopyFilename过程使用GetSaveAsFilename方法显示标准的内置“另存为”对话框，获取备份文件的文件名和保存路径，新建工作簿保存备份数据。

第4行代码，错误处理语句。备份过程中，如果已存在同名工作簿，会出现提示，如果选择了“否”，此时新工作簿已经建立，在执行第12行代码时发生错误，使程序中断，所以使用GoTo语句执行第21行代码，关闭新建立的工作簿。

第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过程，显示内置“另存为”对话框，供用户备份工作簿数据。

▲078 调用操作系统“关于”对话框

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()

DimApphWnd As Long

ApphWnd= FindWindow('XLMAIN'，Application.Caption)

ShellAboutApphWnd，'财务处理系统'，'[e-mail] 0513-86548930'，0

End Sub

代码解析：

第1行到第5行代码是API函数声明。

第8、9行代码调用操作系统的“关于”对话框并显示自定义的内容。

代码运行后显示对话框。

第7部分菜单和工具栏

▲079 在菜单中添加菜单项

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

Sub myTools()

DimmyTools As CommandBarPopup

DimmyCap As Variant

Dimmyid As Variant

Dimi As Byte

myCap= Array('基础应用'，'VBA程序开发'，'函数与公式'，'图表与图形'，'数据透视表')

myid= Array(281，283，285，287，292)

WithApplication.CommandBars('Worksheet menu bar')

.Reset

Set myTools = .Controls('帮助(&H)').Controls.Add(Type:=msoControlPopup，Before:=1)

With myTools

.Caption = 'Excel与VBA'

.BeginGroup = True

For i = 1 To 5

With .Controls.Add(Type:=msoControlButton)

.Caption = myCap(i - 1)

.FaceId = myid(i - 1)

.OnAction = 'myC'

End With

Next

End With

EndWith

SetmyTools = 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是可选的，添加到指定命令栏的控件类型，可以为表格所列的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('Worksheetmenu bar').Reset

End Sub

代码解析：

DelmyTools过程使用Reset方法重置菜单栏，删除添加的菜单项及子菜单。

为了在打开工作簿时自动添加菜单项，需要在工作簿的Activate事件中调用myTools过程，如下面的代码所示。

Private Sub Workbook_Activate()

CallmyTools

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

Private Sub Workbook_Deactivate()

CallDelmyTools

End Sub如果希望这个菜单为所有工作簿使用，那么就应该在工作簿的Open事件中调用myTools过程，在BeforeClose事件中调用DelmyTools过程。

运行myTools过程，将在Excel工作表菜单栏中的“帮助”菜单中添加一个名为“Excel与VBA”的菜单项及五个子菜单。