让Excel自动响应消息框中的提示

2010年01月26日, 12:53 下午

(目前还没有人投票)

Loading ...

这是以前收录的一段程序示例：
使用VBA在调用工作簿中打开被调用工作簿，并运行其中的宏。该宏将弹出一个消息框，如果用户没有响应，那么程序会在指定时间后自动响应。
调用工作簿中的程序代码如下：

Public Declare Function SetTimer& Lib "user32" (ByVal hwnd&, _
    ByVal nIDEvent&, ByVal uElapse&, ByVal lpTimerFunc&)
Private Declare Function KillTimer& Lib "user32" (ByVal hwnd&, _
    ByVal nIDEvent&)
Public Const NV_INPUTBOX As Long = &H5000
 
Public Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    SendKeys "%Y"
    KillTimer hwnd, idEvent
End Sub
 
Sub test()
 
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
 
    Dim targetworkbook As Workbook
 
    Dim usersave As VbMsgBoxResult
 
    Set targetworkbook = Workbooks.Open("C:\test2.xls", UpdateLinks:=0)
 
    Calculate
    targetworkbook.Activate
    SetTimer 0, NV_INPUTBOX, 1000, AddressOf TimerProc
    Application.Run targetworkbook.Name & "!tester"
 
    targetworkbook.Activate
 
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
 
End Sub

假设被调用工作簿存储在C盘，工作簿名为test2.xls，那么其中的代码如下：

Sub tester()
    TimedMsgBox
End Sub
 
Sub TimedMsgBox()
    Dim cTime As Long
    Dim WSH As Object
 
    Set WSH = CreateObject("WScript.Shell")
    cTime = 5 '5 秒
    Select Case WSH.Popup("Open an Excel file?!", cTime, "Question", vbOKCancel)
        Case vbOK
            MsgBox "你单击了确定"
        Case vbCancel
            MsgBox "你单击了取消"
        Case -1
            MsgBox "超时"
    End Select
End Sub