第7章使用對(duì)話框代碼【超實(shí)用VBA】

1、第7章使用對(duì)話框范例113 使用Msgbox函數(shù)顯示消息框Sub Mymsg(Dim Mymsg As IntegerMymsg = MsgBox("文件即將關(guān)閉,是否保存所作的修改?", vbYesNoCancel + vbQuestion Select Case MymsgCase vbYesThisWorkbook.SaveCase vbNoThisWorkbook.Saved = TrueCase vbCancelExit SubEnd SelectThisWorkbook.CloseEnd Sub范例114 自動(dòng)關(guān)閉的消息框114-1 使用WshShell.Pop

2、up方法顯示消息框Sub AutoClose(Dim MyShell As ObjectSet MyShell = CreateObject("Wscript.Shell"MyShell.Popup "程序已執(zhí)行完畢!", 2, "運(yùn)行提示", 64Set MyShell = NothingEnd Sub114-2 使用API函數(shù)顯示消息框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 "程序已執(zhí)行完畢!", 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函數(shù)輸入數(shù)據(jù)Sub MyInput(Dim Str As StringStr = InputBox(prompt:="請(qǐng)輸入數(shù)據(jù):"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("請(qǐng)輸入密碼:", "Microsoft Excel"If Str = "12345678" ThenMsgBox "密碼輸

10、入正確!"ElseMsgBox "密碼輸入錯(cuò)誤!"End IfEnd Sub范例116 使用InputBox方法116-1 輸入指定類型的數(shù)據(jù)Sub EnterNumbers(Dim myInput As LongDim r As IntegerWith Sheet1r = .Cells(.Rows.Count, 1.End(xlUp.RowmyInput = Application.InputBox(Prompt:="輸入數(shù)字:", Type:=1If myInput <> False Then.Cells(r + 1, 1.Va

11、lue = myInputEnd IfEnd WithEnd Sub116-2 獲得選定的單元格區(qū)域Sub SelecteRange(Dim rng As RangeOn Error Resume NextSet rng = Application.InputBox(Prompt:="請(qǐng)選擇單元格區(qū)域:", Type:=8 rng.Interior.ColorIndex = 15Set rng = NothingEnd Sub范例117 使用內(nèi)置對(duì)話框117-1 調(diào)用Excel內(nèi)置對(duì)話框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:="請(qǐng)選擇文件", MultiSelect:=TrueIf IsArray(FileName ThenFor i = 1 To UBound(FileNameStr = Str & FileName(i & Chr(10NextMsgBox StrEnd IfEnd Sub117-3 使用“另存為”對(duì)話框備份文件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 調(diào)用操作系統(tǒng)的“關(guān)于”對(duì)話框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