- ホーム
- Other
- Control Acrobat
タイマーを用いて自動でpdfのページをめくる
タイマーを用いて一定時間おきにpdfのページをめくれないかと思って調べてみました。そのためにExcelｌ起動は大げさなので、軽いツールを目指しました。
VBScriptでやることにし、最初DDEでの制御も考えましたが、レジストリをいじる様なコードになる様なので、断念してOLEにしました。
途中で手動でページを進めたり、戻したりした場合にも対応出来る様にしてあります。最終ページまで進むと終了します。
vbsファイルのアイコンにpdfをドラッグ＆ドロップするか、バッチファイルを作成しファイルのフルパスと、インターバル時間（ミリ秒）をスペース区切りで与えます
半角スペースを含むファイルパスの場合は、ダブルクォーテーションで囲む必要があります。
Acrobat 6,7,9 std.で動作確認しました。残念ながらAdobe Reader は最新版になってもOLEには対応していませんでした。
なお、ツールバーを消す制御がV6以前とV7以降で異なっており、コード中でAcrobatのバージョンを取得して分岐する方法が分かりませんので
コメントを参考に、ソースを修正する必要があります。
おまけに、Excel-VBA & Adobe Reader版を作成してみました。表示されるフォームにエクスプローラーからpdfファイルをドラッグ＆ドロップします。
WaitableTimerの使用や、フォームの最前面表示（本来はフレーム無しにしたかった）のためのAPIで無駄に長いです。
Option Explicit
'オブジェクト
Dim objAcroApp
Dim objAcroAVDoc
Dim objAcroPDDoc
dim objAVPageView
Dim bRet
dim lRet
dim lPageCount
dim I
Dim oParam
Dim idx
Dim interval
Dim CON_PDF_PATH
Dim rect
Public Const avpShowToolBar = 3
'タイムアウト(秒)設定 誤動作対策
'Wscript.Timeout = 1800
'コマンドライン引数（パラメータ）の取得
Set oParam = Wscript.Arguments
if oParam.Count=0 then Wscript.Quit()
if oParam.Count>1 then
interval=oParam(1)
else
'どうも時間が設定より短い感あり。体感半分。
Interval=10000
end if
CON_PDF_PATH=oParam(0)
'Acrobatアプリケーションを起動する。
Set objAcroApp= CreateObject("AcroExch.App")
lRet = objAcroApp.Show
'ツールバーを非表示にする
'bRet = objAcroApp.SetPreferenceEx(avpShowToolBar, False) 'V7以降
bRet = objAcroApp.SetPreference(avpShowToolBar, False) 'V6以前
set rect = objAcroApp.Getframe()
rect.top=0
rect.left=500
rect.right=rect.left+500
rect.bottom=750
lRet = objAcroApp.Setframe(rect)
'PDFファイルを開いて表示する。
Set objAcroAVDoc =CreateObject("AcroExch.AVDoc")
lRet = objAcroAVDoc.Open(CON_PDF_PATH,"")
'これをやってもAcrobat6の「使い方」は消えない
'lRet = objAcroAVDoc.SetViewMode(1)
lRet = objAcroAVDoc.Maximize(1)
'PDDocを取得する
Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
'ページ数を取得する
lPageCount = objAcroPDDoc.GetNumPages()
'GetAVPageViewオブジェクトを作成する。
Set objAVPageView = objAcroAVDoc.GetAVPageView
'ページ数だけループを回す。
Do While i<lPageCount
'for i =0 to lPageCount -1
if i=0 then
i=i+1
else
'画面表示している頁番号を取得する。手動ページ送りに対応。
'これも1ページ=0,2ページ=1の決まり
i=objAVPageView.GetPageNum()
'PDFファイルの指定ページを表示する。
i=i+1
lRet = objAVPageView.Goto(i)
end if
Wscript.Sleep interval
Loop
'Next
'PDFファイルを全て閉じる。
lRet = objAcroApp.CloseAllDocs
'アプリケーションの終了
lRet = objAcroApp.Hide
lRet = objAcroApp.Exit
'オブジェクトの強制開放
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
Wscript.Quit() 'スクリプトの終了
'==============================================
' Excel & Adobe Reader 版です
'☆標準モジュール
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Const WAIT_ABANDONED& = &H80&
Private Const WAIT_ABANDONED_0& = &H80&
Private Const WAIT_FAILED& = -1&
Private Const WAIT_IO_COMPLETION& = &HC0&
Private Const WAIT_OBJECT_0& = 0
Private Const WAIT_OBJECT_1& = 1
Private Const WAIT_TIMEOUT& = &H102&
Private Const INFINITE = &HFFFF
Private Const ERROR_ALREADY_EXISTS = 183&
Private Const QS_HOTKEY& = &H80
Private Const QS_KEY& = &H1
Private Const QS_MOUSEBUTTON& = &H4
Private Const QS_MOUSEMOVE& = &H2
Private Const QS_PAINT& = &H20
Private Const QS_POSTMESSAGE& = &H8
Private Const QS_SENDMESSAGE& = &H40
Private Const QS_TIMER& = &H10
Private Const QS_MOUSE& = (QS_MOUSEMOVE _
Or QS_MOUSEBUTTON)
Private Const QS_INPUT& = (QS_MOUSE _
Or QS_KEY)
Private Const QS_ALLEVENTS& = (QS_INPUT _
Or QS_POSTMESSAGE _
Or QS_TIMER _
Or QS_PAINT _
Or QS_HOTKEY)
Private Const QS_ALLINPUT& = (QS_SENDMESSAGE _
Or QS_PAINT _
Or QS_TIMER _
Or QS_POSTMESSAGE _
Or QS_MOUSEBUTTON _
Or QS_MOUSEMOVE _
Or QS_HOTKEY _
Or QS_KEY)
Private Declare Function CreateWaitableTimer Lib "kernel32" _
Alias "CreateWaitableTimerA" ( _
ByVal lpSemaphoreAttributes As Long, _
ByVal bManualReset As Long, _
ByVal lpName As String) As Long
Private Declare Function OpenWaitableTimer Lib "kernel32" _
Alias "OpenWaitableTimerA" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal lpName As String) As Long
Private Declare Function SetWaitableTimer Lib "kernel32" ( _
ByVal hTimer As Long, _
lpDueTime As FILETIME, _
ByVal lPeriod As Long, _
ByVal pfnCompletionRoutine As Long, _
ByVal lpArgToCompletionRoutine As Long, _
ByVal fResume As Long) As Long
Private Declare Function CancelWaitableTimer Lib "kernel32" ( _
ByVal hTimer As Long)
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Private Declare Function MsgWaitForMultipleObjects Lib "user32" ( _
ByVal nCount As Long, _
pHandles As Long, _
ByVal fWaitAll As Long, _
ByVal dwMilliseconds As Long, _
ByVal dwWakeMask As Long) As Long
Public doc As AcroPDF
Sub showForm()
UserForm1.Show vbModeless
End Sub
'UserForm1のWebBrowser1_NavigateComplete2イベントからOnTimeで実行するプロシージャ
Public Sub autoPager()
On Error GoTo errhandle
Set doc = UserForm1.WebBrowser1.Document
doc.gotoFirstPage
doc.setPageMode "none"
doc.setLayoutMode "SinglePage"
'最終ページまで送るとそこで止まり、特にエラーも出ない
Do
Wait UserForm1.ScrollBar1.Value
If doc Is Nothing Then Exit Sub
doc.gotoNextPage
Loop
errhandle:
Unload UserForm1
End Sub
'http://support.microsoft.com/kb/231298/ja
'Sleep 関数の代わりに SetWaitableTimer を使用することができます。
'この関数では、画面の再描画や、DDE メッセージの表示などが可能です。
Public Sub Wait(lNumberOfSeconds As Long)
Dim ft As FILETIME
Dim lBusy As Long
Dim lRet As Long
Dim dblDelay As Double
Dim dblDelayLow As Double
Dim dblUnits As Double
Dim hTimer As Long
hTimer = CreateWaitableTimer(0, True, Application.Name & "Timer")
If Err.LastDllError = ERROR_ALREADY_EXISTS Then
Else
ft.dwLowDateTime = -1
ft.dwHighDateTime = -1
lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, 0)
End If
dblUnits = CDbl(&H10000) * CDbl(&H10000)
dblDelay = CDbl(lNumberOfSeconds) * 1000 * 10000
ft.dwHighDateTime = -CLng(dblDelay / dblUnits) - 1
dblDelayLow = -dblUnits * (dblDelay / dblUnits - _
Fix(dblDelay / dblUnits))
If dblDelayLow < CDbl(&H80000000) Then
dblDelayLow = dblUnits + dblDelayLow
ft.dwHighDateTime = ft.dwHighDateTime + 1
End If
ft.dwLowDateTime = CLng(dblDelayLow)
lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, False)
Do
lBusy = MsgWaitForMultipleObjects(1, hTimer, False, _
INFINITE, QS_ALLINPUT&)
DoEvents
Loop Until lBusy = WAIT_OBJECT_0
CloseHandle hTimer
End Sub
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex 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 GetSystemMetrics _
Lib "user32" _
(ByVal nIndex As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal uFlags As Long) As Long
Private Const SM_CXSCREEN As Long = 0
Private Const SM_CYSCREEN As Long = 1
Private Const GWL_STYLE = -16
Private Const GWL_EXSTYLE = -20
Private Const WS_CAPTION = &HC00000 'タイトルバーを持つウィンドウ
Private Const WS_SYSMENU = &H80000 'タイトルバー上にウィンドウメニューボックスを持つウィンドウ
Private Const WS_MINIMIZEBOX = &H20000 '最小化ボタンを持つウィンドウを作成します。
Private Const WS_MAXIMIZEBOX = &H10000 '最大化ボタンを持つウィンドウ
Private Const WS_EX_DLGMODALFRAME = &H1& '二重の境界線を持つウィンドウ
Private Const HWND_TOPMOST = -1& '常に手前に表示
Private Const HWND_TOP = 0 '手前に表示
Private Const SWP_FRAMECHANGED = &H20
'Adobe Acrobat Browser Control Type Library 1.0に参照設定、コード完成後は As Objectで十分
'以下Adobe社の文書より引用
'PDF.OCX ActiveX コントロールは Netscape および Internet Explorer のために用意されたものであり、
'これらのアプリケーションで使用するためにのみテストされています。＜中略＞
'InternetExplorer ActiveX Control を使用する場合は、ご自分のシステムに Internet Explorer 3.01
'以降のバージョンをインストールする必要があります。
'
'これらのインターフェース（Netscape プラグインおよび Internet Explorer ActiveX Control）は、
'バージョンが変わるたびに各ブラウザの能力の優位性を引き出すために変更され、API も変更されます。
'そのため、このインターフェースを用いての開発はお勧めできません。また、弊社では、PDF.OCX を
'利用した開発に関するサポートを提供しておりません。
'☆UserForm1モジュール
'Scrollbar一個と、Webbrowser一個を置く。位置、寸法はコードで設定している。
Dim m_hwnd As Long
Private Sub UserForm_Initialize()
Dim myX As Long, myY As Long
Const scrollBarHeight As Long = 12
On Error GoTo errhandle
'画面の幅を取得
myX = GetSystemMetrics(SM_CXSCREEN)
'画面の高さを取得
myY = GetSystemMetrics(SM_CYSCREEN)
With Me
'UserFormのpicture設定
.StartUpPosition = 0
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeClip
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
'フォームに時刻を名前としてつける
.Caption = .Caption & Timer()
End With
'名前を手がかりとして、ユーザーフォームのハンドルを取得
m_hwnd = FindWindow("ThunderDFrame", Me.Caption)
'フォームの表示順（Zオーダー）、サイズ指定
myX = CLng(myY * 210 / 297)
SetWindowPos m_hwnd, HWND_TOPMOST, 0, 0, myX, myY, _
SWP_FRAMECHANGED
With Me.ScrollBar1
.Top = 0
.Left = 0
.Height = scrollBarHeight
.Width = Me.InsideWidth
.Value = 4
.Max = 30
.Min = 2
.SmallChange = 2
.LargeChange = 6
.TabIndex = 2
.TabStop = False '点滅防止、TabIndexと併用で設定してみたが効果無し
End With
With Me.WebBrowser1
.Top = 0 + scrollBarHeight
.Left = 0
.Width = Me.InsideWidth
.Height = Me.InsideHeight - scrollBarHeight
.TabIndex = 1
End With
Application.Visible = False
Exit Sub
errhandle:
Application.Visible = True
End Sub
Private Sub UserForm_Terminate()
If Not doc Is Nothing Then
doc.LoadFile ""
Set doc = Nothing
End If
Sleep 1000
Application.Visible = True
End Sub
Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
'このなかでページ送りのループを回すと、動作はするがフォームを閉じた後
'Excelがシャットダウンしてしまう
'Event中で色々やるのがまずいのかと別ルーチンに分けてみたところ解決したっぽい
Application.OnTime Now + TimeValue("00:00:01"), "autoPager"
End Sub
'Escキーで終了させたかったが、AdobeReader側に制御が移ってしまって制御不能となる
'Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
' Select Case KeyCode.Value
' Case vbKeyEscape 'ESCでフォームを閉じる
' Unload Me
' ActiveSheet.Select
' Exit Sub
' End Select
'End Sub