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

1、第7章使用对话框范例113 使用Msgbox函数显示消息框Sub Mymsg(Dim Mymsg As IntegerMymsg = MsgBox("文件即将关闭,是否保存所作的修改?", vbYesNoCancel + vbQuestion Select Case MymsgCase vbYesThisWorkbook.SaveCase vbNoThisWorkbook.Saved = TrueCase vbCancelExit SubEnd SelectThisWorkbook.CloseEnd Sub范例114 自动关闭的消息框114-1 使用WshShell.Pop

2、up方法显示消息框Sub AutoClose(Dim MyShell As ObjectSet MyShell = CreateObject("Wscript.Shell"MyShell.Popup "程序已执行完毕!", 2, "运行提示", 64Set MyShell = NothingEnd Sub114-2 使用API函数显示消息框Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long

3、, 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 MyTimer As LongSub AutoClose(MyTimer = SetTimer(0, 0, 2000, AddressOf CloseMsgMsgBox "程序已执行完毕!", 64End SubSub CloseMsg(

4、ByVal hWnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As LongApplication.SendKeys "", TrueKillTimer 0, MyTimerEnd Sub范例115 使用InputBox函数输入数据Sub MyInput(Dim Str As StringStr = InputBox(prompt:="请输入数据:"If Len(Trim(Str > 0 ThenCells(Rows.Count, 1.End(xlUp.Of

5、fset(1, 0 = StrEnd IfEnd SubPublic Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String As LongPublic Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVa

6、l hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String As LongPublic 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

7、" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long As LongPublic Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long As Long Public Declare Function GetTickCount Lib "kernel32" ( As LongPubli

8、c Const EM_SETPASSWORDCHAR = &HCCPublic lTimeID As LongSub TimeProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As LongDim hwd As Longhwd = FindWindow("#32770", "Microsoft Excel"If hwd <> 0 Thenhwd = FindWindowEx(hwd, 0, &qu

9、ot;edit", vbNullStringSendMessage hwd, EM_SETPASSWORDCHAR, 42, 0timeKillEvent lTimeIDEnd IfEnd SubSub PassInput(Dim Str As StringlTimeID = timeSetEvent(10, 0, AddressOf TimeProc, 1, 1Str = InputBox("请输入密码:", "Microsoft Excel"If Str = "12345678" ThenMsgBox "密码输

10、入正确!"ElseMsgBox "密码输入错误!"End IfEnd Sub范例116 使用InputBox方法116-1 输入指定类型的数据Sub EnterNumbers(Dim myInput As LongDim r As IntegerWith Sheet1r = .Cells(.Rows.Count, 1.End(xlUp.RowmyInput = Application.InputBox(Prompt:="输入数字:", Type:=1If myInput <> False Then.Cells(r + 1, 1.Va

11、lue = myInputEnd IfEnd WithEnd Sub116-2 获得选定的单元格区域Sub SelecteRange(Dim rng As RangeOn Error Resume NextSet rng = Application.InputBox(Prompt:="请选择单元格区域:", Type:=8 rng.Interior.ColorIndex = 15Set rng = NothingEnd Sub范例117 使用内置对话框117-1 调用Excel内置对话框Sub MyFont(If TypeName(Selection = "Ran

12、ge" ThenApplication.Dialogs(xlDialogActiveCellFont.Show _arg1:="黑体", arg2:="加粗倾斜", arg3:=30, _arg4:=True, arg10:=3, arg11:=FalseEnd IfEnd Sub117-2 获取所选文件的文件名和路径Sub FileNameAndPath(Dim FilterList As StringDim FileName As VariantDim i As IntegerDim Str As StringFilterList = &q

13、uot;All Files (*.*,*.*,Excel Files(*.xlsm,*.xlsm"FileName = Application.GetOpenFilename(FileFilter:=FilterList, _Title:="请选择文件", MultiSelect:=TrueIf IsArray(FileName ThenFor i = 1 To UBound(FileNameStr = Str & FileName(i & Chr(10NextMsgBox StrEnd IfEnd Sub117-3 使用“另存为”对话框备份文件S

14、ub FileBackup(Dim FileName As StringDim FilePath As StringDim FilterList As StringOn Error GoTo lineFilePath = "D:" & Format(Date, "yyyymmdd" & "备份文件.xlsx"FilterList = "Excel Files(*.xlsx,*.xlsx,All Files (*.*,*.*"FileName = Application.GetSaveAsFilena

15、me(InitialFileName:=FilePath, FileFilter:=FilterList, Title:="文件备份"If FileName <> "False" ThenSheet2.CopyActiveWorkbook.Close SaveChanges:=True, FileName:=FileName End IfExit Subline:ActiveWorkbook.Close FalseEnd Sub范例118 调用操作系统的“关于”对话框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 LongPrivate Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByV