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,'财务处理系统','yuanzhuping@yeah.net 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”的菜单项及五个子菜单。
联系客服