幻灯式Excel打印预览

此程序的可以在指定的时间自动关闭打印预览窗口，当打印页面不止1页时，可以每隔一定的时间自动切换到下一页，切换完成后自动关闭。

Option Explicit
''---声明API---
'//用来产生TIMER控件的效果
Private Declare Function SetTimer _
    Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal nIDEvent As Long, _
        ByVal uElapse As Long, _
        ByVal lpTimerFunc As Long) _
As Long
'//结束Settimer过程
Private Declare Function KillTimer _
    Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal nIDEvent As Long) _
As Long
'//判断窗口是否处于活动状态
Private Declare Function IsWindowEnabled _
    Lib "user32" ( _
        ByVal hwnd As Long) _
As Long
'//查找窗体
Private Declare Function FindWindow _
    Lib "user32" _
    Alias "FindWindowA" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) _
As Long
'//在窗口列表中寻找与指定条件相符的第一个子窗口
Private Declare Function FindWindowEx _
    Lib "user32" _
    Alias "FindWindowExA" ( _
        ByVal hWnd1 As Long, _
        ByVal hWnd2 As Long, _
        ByVal lpsz1 As String, _
        ByVal lpsz2 As String) _
As Long
'//取得一个窗体的标题（caption）文字，或者一个控件的内容
Private Declare Function GetWindowText _
    Lib "user32" _
    Alias "GetWindowTextA" ( _
        ByVal hwnd As Long, _
        ByVal lpString As String, _
        ByVal cch As Long) _
As Long
'---声明变量---
Dim TID As Long
Dim BinSet As Boolean
'**************************************************************************
'---回调---
'**************************************************************************
Sub pMsgOutProc()
    Static TotalSecs As Long
    '加入打印预览窗口存在
    If pntPreviewHwnd <> 0 Then
        '累加计时
        TotalSecs = TotalSecs + 200
        '假如累计计时大于2000毫秒
        If TotalSecs >= 2000 Then
            '假如 "下一页" 按钮可用
            If BIsWindowEnabled = True Then
                '计时器清零
                TotalSecs = 0
                '发送Alt和n键
                VBA.SendKeys "%n"
            Else
                '计时器清零
                TotalSecs = 0
                '发送Alt和c键
                VBA.SendKeys "%c"
            End If
        End If
    Else
        '计时器清零
        TotalSecs = 0
    End If
End Sub
'*******************************************************************************
Sub EnbleCheck()
    If BinSet = False Then
        TID = SetTimer(0, 0, 200, AddressOf pMsgOutProc)
        BinSet = True
    End If
End Sub
'*******************************************************************************
Sub FreeCheck()
    KillTimer 0, TID
    BinSet = False
End Sub
'*******************************************************************************
'---判断打印预览是否打开---
'*******************************************************************************
Function pntPreviewHwnd() As Long
  Dim XLhwnd As Long
  '取得Excel主窗口的句柄（Xp以上版本可以直接使用Application.Hwnd）
  XLhwnd = FindWindow("XLMAIN", Application.Caption)
  '取得打印预览功能区窗口句柄
  pntPreviewHwnd = FindWindowEx(XLhwnd, 0&, "EXCELC", vbNullString)
End Function
'********************************************************************************
'---判断 "下一页" 按钮是否可用---
'********************************************************************************
Function BIsWindowEnabled() As Boolean
    Dim XLhwnd As Long, pntPreviewHwnd As Long, WindowText As String, pntNextButtonHwnd As Long
    '取得Excel主窗口的句柄（Xp以上版本可以直接使用Application.Hwnd）
    XLhwnd = FindWindow("XLMAIN", Application.Caption)
    '取得打印预览功能区窗口句柄
    pntPreviewHwnd = FindWindowEx(XLhwnd, 0&, "EXCELC", vbNullString)
    '按钮不可用
    BIsWindowEnabled = False
    '取得第一个按钮句柄
    pntNextButtonHwnd = FindWindowEx(pntPreviewHwnd, 0&, "Button", vbNullString)
    '还存在子按钮时则循环
    Do While pntNextButtonHwnd <> 0
        WindowText = String(255, Chr(0))
        '取得按钮的标题
        GetWindowText pntNextButtonHwnd, WindowText, 255
        WindowText = Left(WindowText, InStr(WindowText, vbNullChar) - 1)
        '假如按钮为 "下一页"
        If WindowText = "下一页(&N)" Then
            '假如按钮可用
            If IsWindowEnabled(pntNextButtonHwnd) <> 0 Then
                '按钮可用
                BIsWindowEnabled = True
                '退出循环
                Exit Do
            End If
        End If
        '取得下一个按钮的句柄
        pntNextButtonHwnd = FindWindowEx(pntPreviewHwnd, pntNextButtonHwnd, "Button", vbNullString)
    Loop
End Function

参见附件（只适用简体中文，其它语言请自行修改。附件的页面切换为2秒

点击下载