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

第7章 使用对话框范例113 使用Msgbox函数显示消息框Sub Mymsg() Dim Mymsg As Integer Mymsg = MsgBox(文件即将关闭,是否保存所作的修改?, vbYesNoCancel + vbQuestion) Select Case Mymsg Case vbYes ThisWorkbook.Save Case vbNo ThisWorkbook.Saved = True Case vbCancel Exit Sub End Select ThisWorkbook.CloseEnd Sub范例114 自动关闭的消息框114-1 使用WshShell.Popup方法显示消息框Sub AutoClose() Dim MyShell As Object Set MyShell = CreateObject(Wscript.Shell) MyShell.Popup 程序已执行完毕!, 2, 运行提示, 64 Set MyShell = NothingEnd Sub114-2 使用API函数显示消息框Public Declare Function SetTimer Lib user32 (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElaspe As Long, ByVal lpTimerFunc As Long) As LongPublic 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 CloseMsg) MsgBox 程序已执行完毕!, 64End SubSub CloseMsg(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long) Application.SendKeys , True KillTimer 0, MyTimerEnd Sub范例115 使用InputBox函数输入数据Sub MyInput() Dim Str As String Str = InputBox(prompt:=请输入数据：) If Len(Trim(Str) 0 Then Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = Str End 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, ByVal 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 LongPublic Declare Function timeSetEvent Lib winmm.dll (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 LongPublic Declare Function GetTickCount Lib kernel32 () As LongPublic 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 Long) Dim hwd As Long hwd = FindWindow(#32770, Microsoft Excel) If hwd 0 Then hwd = FindWindowEx(hwd, 0, edit, vbNullString) SendMessage hwd, EM_SETPASSWORDCHAR, 42, 0 timeKillEvent lTimeID End If End SubSub PassInput() Dim Str As String lTimeID = timeSetEvent(10, 0, AddressOf TimeProc, 1, 1) Str = InputBox(请输入密码：, Microsoft Excel) If Str = 12345678 Then MsgBox 密码输入正确! Else MsgBox 密码输入错误! End IfEnd Sub范例116 使用InputBox方法116-1 输入指定类型的数据Sub EnterNumbers() Dim myInput As Long Dim r As Integer With Sheet1 r = .Cells(.Rows.Count, 1).End(xlUp).Row myInput = Application.InputBox(Prompt:=输入数字：, Type:=1) If myInput False Then .Cells(r + 1, 1).Value = myInput End If End WithEnd Sub116-2 获得选定的单元格区域Sub SelecteRange() Dim rng As Range On Error Resume Next Set rng = Application.InputBox(Prompt:=请选择单元格区域：, Type:=8) rng.Interior.ColorIndex = 15 Set rng = NothingEnd Sub范例117 使用内置对话框117-1 调用Excel内置对话框Sub MyFont() If TypeName(Selection) = Range Then Application.Dialogs(xlDialogActiveCellFont).Show _ arg1:=黑体, arg2:=加粗 倾斜, arg3:=30, _ arg4:=True, arg10:=3, arg11:=False End IfEnd Sub117-2 获取所选文件的文件名和路径Sub FileNameAndPath() Dim FilterList As String Dim FileName As Variant Dim i As Integer Dim Str As String FilterList = All Files (*.*),*.*,Excel Files(*.xlsm),*.xlsm FileName = Application.GetOpenFilename(FileFilter:=FilterList, _ Title:=请选择文件, MultiSelect:=True) If IsArray(FileName) Then For i = 1 To UBound(FileName) Str = Str & FileName(i) & Chr(10) Next MsgBox Str End IfEnd Sub117-3 使用“另存为”对话框备份文件Sub FileBackup() Dim FileName As String Dim FilePath As String Dim FilterList As String On Error GoTo line FilePath = D: & Format(Date, yyyymmdd) & 备份文件.xlsx FilterList = Excel Files(*.xlsx),*.xlsx,All Files (*.*),*.* FileName = Application.GetSaveAsFilename(InitialFileName:=FilePath, FileFilter:=FilterList, Title:=文件备份) If FileName False Then Sheet2.Copy ActiveWorkbook.Close SaveChanges:=True, FileName:=FileName End If Exit 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 (ByVa