幻灯式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秒

点击下载