第7章--使用对话框代码【超实用VBA】

79第7章使用对话框范例113使用Msgbox函数显示消息框SubMymsg()DimMymsgAsIntegerMymsg=MsgBox(文件即将关闭,是否保存所作的修改?,vbYesNoCancel+vbQuestion)SelectCaseMymsgCasevbYesThisWorkbook.SaveCasevbNoThisWorkbook.Saved=TrueCasevbCancelExitSubEndSelectThisWorkbook.CloseEndSub范例114自动关闭的消息框114-1使用WshShell.Popup方法显示消息框SubAutoClose()DimMyShellAsObjectSetMyShell=CreateObject(Wscript.Shell)MyShell.Popup程序已执行完毕!,2,运行提示,64SetMyShell=NothingEndSub114-2使用API函数显示消息框PublicDeclareFunctionSetTimerLibuser32(ByValhWndAsLong,ByValnIDEventAsLong,ByValuElaspeAsLong,ByVallpTimerFuncAsLong)AsLongPublicDeclareFunctionKillTimerLibuser32(ByValhWndAsLong,ByValnIDEventAsLong)AsLong80DimMyTimerAsLongSubAutoClose()MyTimer=SetTimer(0,0,2000,AddressOfCloseMsg)MsgBox程序已执行完毕!,64EndSubSubCloseMsg(ByValhWndAsLong,ByValuMsgAsLong,ByValideventAsLong,ByValSystimeAsLong)Application.SendKeys~,TrueKillTimer0,MyTimerEndSub范例115使用InputBox函数输入数据SubMyInput()DimStrAsStringStr=InputBox(prompt:=请输入数据：)IfLen(Trim(Str))0ThenCells(Rows.Count,1).End(xlUp).Offset(1,0)=StrEndIfEndSubPublicDeclareFunctionFindWindowLibuser32AliasFindWindowA(ByVallpClassNameAsString,ByVallpWindowNameAsString)AsLongPublicDeclareFunctionFindWindowExLibuser32AliasFindWindowExA(ByValhWnd1AsLong,ByValhWnd2AsLong,ByVallpsz1AsString,ByVallpsz2AsString)AsLongPublicDeclareFunctionSendMessageLibuser32AliasSendMessageA(ByValhwndAsLong,ByValwMsgAsLong,ByValwParamAsLong,lParamAsAny)AsLongPublicDeclareFunctiontimeSetEventLibwinmm.dll(ByValuDelayAsLong,ByValuResolutionAsLong,ByVallpFunctionAsLong,ByValdwUserAsLong,ByValuFlagsAsLong)AsLongPublicDeclareFunctiontimeKillEventLibwinmm.dll(ByValuIDAsLong)AsLongPublicDeclareFunctionGetTickCountLibkernel32()AsLongPublicConstEM_SETPASSWORDCHAR=&HCCPubliclTimeIDAsLongSubTimeProc(ByValuIDAsLong,ByValuMsgAsLong,ByValdwUserAsLong,ByValdw1AsLong,ByValdw2AsLong)DimhwdAsLonghwd=FindWindow(#32770,MicrosoftExcel)81Ifhwd0Thenhwd=FindWindowEx(hwd,0,edit,vbNullString)SendMessagehwd,EM_SETPASSWORDCHAR,42,0timeKillEventlTimeIDEndIfEndSubSubPassInput()DimStrAsStringlTimeID=timeSetEvent(10,0,AddressOfTimeProc,1,1)Str=InputBox(请输入密码：,MicrosoftExcel)IfStr=12345678ThenMsgBox密码输入正确!ElseMsgBox密码输入错误!EndIfEndSub范例116使用InputBox方法116-1输入指定类型的数据SubEnterNumbers()DimmyInputAsLongDimrAsIntegerWithSheet1r=.Cells(.Rows.Count,1).End(xlUp).RowmyInput=Application.InputBox(Prompt:=输入数字：,Type:=1)IfmyInputFalseThen.Cells(r+1,1).Value=myInputEndIfEndWithEndSub116-2获得选定的单元格区域SubSelecteRange()DimrngAsRangeOnErrorResumeNextSetrng=Application.InputBox(Prompt:=请选择单元格区域：,Type:=8)rng.Interior.ColorIndex=15Setrng=NothingEndSub82范例117使用内置对话框117-1调用Excel内置对话框SubMyFont()IfTypeName(Selection)=RangeThenApplication.Dialogs(xlDialogActiveCellFont).Show_arg1:=黑体,arg2:=加粗倾斜,arg3:=30,_arg4:=True,arg10:=3,arg11:=FalseEndIfEndSub117-2获取所选文件的文件名和路径SubFileNameAndPath()DimFilterListAsStringDimFileNameAsVariantDimiAsIntegerDimStrAsStringFilterList=AllFiles(*.*),*.*,ExcelFiles(*.xlsm),*.xlsmFileName=Application.GetOpenFilename(FileFilter:=FilterList,_Title:=请选择文件,MultiSelect:=True)IfIsArray(FileName)ThenFori=1ToUBound(FileName)Str=Str&FileName(i)&Chr(10)NextMsgBoxStrEndIfEndSub117-3使用“另存为”对话框备份文件SubFileBackup()DimFileNameAsStringDimFilePathAsStringDimFilterListAsStringOnErrorGoTolineFilePath=D:\&Format(Date,yyyymmdd)&备份文件.xlsxFilterList=ExcelFiles(*.xlsx),*.xlsx,AllFiles(*.*),*.*FileName=Application.GetSaveAsFilename(InitialFileName:=FilePath,FileFilter:=FilterList,Title:=文件备份)IfFileNameFalseThen83Sheet2.CopyActiveWorkbook.CloseSaveChanges:=True,FileName:=FileNameEndIfExitSubline:ActiveWorkbook.CloseFalseEndSub范例118调用操作系统的“关于”对话框PrivateDeclareFunctionShellAboutLibshell32.dllAliasShellAboutA(ByValhwndAsLong,ByValszAppAsString,ByValszOtherStuffAsString,ByValhIconAsLong)AsLongPrivateDeclareFunctionFindWindowLibuser32AliasFindWindowA(ByVallpClassNameAsString,ByVallpWindowNameAsString)AsLongSubSystemDialogBox()DimApphWndAsLongApphWnd=FindWindow(XLMAIN,Application.Caption)ShellAboutApphWnd,财务处理系统,[e-mail]0513-86XXXX30,0EndSub