事務作業を効率化するため、最近ExcelVBAを学び始めた者です。
初質問のため、質問内容やコードにわかりづらいことがありましたら誠に申し訳ございません。何卒宜しくお願いいたします。
目的
-PDFファイルを開き、ExcelワークシートにShapeとしてPDF画像を追加する-
上記を達成するためのより良い方法を知りたい
使用アプリケーション
・Excel 2016
・Adobe Acrobat Reader DC(無償版)
内容
ExcelVBAで、PDF画像をシートに追加するマクロを作ろうと考えており、方法を模索しております。最初はExcelの機能を使ったPDFファイルの挿入を考えていましたが、どうにも解像度が悪くなってしまいます。貼り付ける画像はスキャンされた画像で、もともと見えづらいため、これ以上画質は落としたくないと思っています。そのため、Adobe Acrobat ReaderでPDFファイルを開き、表示されたPDF画像をVBAの外部アプリケーション操作でクリップボードにコピーしペーストする、という方法をとることにしました。試行錯誤の結果、一応は完成しましたが、かなりのゴリ押しとなってしまいました。そのため、もっと良い方法がないか知りたいと思っています。以下のソースコードは[表示されているAcrobat ReaderのPDF画像をクリップボードにコピーするまで]の段階です。
完成品ソースコード(抜粋)
Option Explicit
'ウインドウハンドルを取得する
Public 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 hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
'ウインドウのキャプションタイトルを取得する
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
'ウインドウのクラス名を取得する
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
'ウインドウが可視かどうかを取得する
Public Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
'次または前のウインドウハンドルを取得する
Public Declare Function GetNextWindow Lib "user32" Alias "GetWindow" _
(ByVal hWnd As Long, ByVal wFlag As Long) As Long
'システムメニュー取得関連
Public Declare Function GetMenu Lib "User32.dll" _
(ByVal hWnd As Long) As Long
Public Declare Function GetMenuItemCount Lib "User32.dll" _
(ByVal hMenu As Long) As Long
Public Declare Function GetSubMenu Lib "User32.dll" _
(ByVal hWnd As Long, _
ByVal nPos As Long) As Long
Public Declare Function GetMenuItemID Lib "User32.dll" _
(ByVal hWnd As Long, _
ByVal nPos As Long) As Long
'IAccessible関連
Public Declare Function AccessibleChildren Lib "oleacc" _
(ByVal paccContainer As IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
Public Declare Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As Any, ByRef ppvObject As IAccessible) As Long
Public Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, lpiid As Any) As Long
Public Const OBJID_SYSMENU = &HFFFFFFFF
Public Const OBJID_WINDOW = &H0
'キーポスト
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SendMessage Lib "User32.dll" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'キーボードイベント
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Const KEYEVENTF_EXTENDEDKEY = &H1
Public Const KEYEVENTF_KEYUP = &H2
Public Const fKEYDOWN = KEYEVENTF_EXTENDEDKEY
Public Const fKEYUP = KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP
Public Const VK_C = &H43
Public Const VK_CONTROL = &H11
'ウインドウを最前面にする
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
'待機(実行待ち用)
Public Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
'キー内容
Public Const WM_CLOSE = &H10
Public Const WM_KEYDOWN = &H100
Public Const WM_COMMAND = &H111
Public Const WM_CHAR = &H102
'GetNextWindow(終了判定)
Public Const GW_HWNDLAST = 1
'GetNextWindow(次のウインドウ)
Public Const GW_HWNDNEXT = 2
'マウス操作関連
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Sub mouse_event Lib "user32" ( _
ByVal dwFlags As Long, _
Optional ByVal dx As Long = 0, _
Optional ByVal dy As Long = 0, _
Optional ByVal dwDate As Long = 0, _
Optional ByVal dwExtraInfo As Long = 0)
Public Sub PDFCopy()
Dim hwndC As Long: hwndC = FindWindow(vbNullString, vbNullString) '1つめのウインドウを取得する
Dim strClassC As String * 60
Dim uiAuto As CUIAutomation: Set uiAuto = New CUIAutomation
Dim ElmAcro As IUIAutomationElement 'Acrobat Readerアプリケーションウインドウ
Dim ElmWin As IUIAutomationElement 'Acrobat Readerアプリケーションのページビューウインドウ
Dim ICnd As IUIAutomationCondition 'Elementを検索するための条件
Dim Mousept As tagPOINT 'マウスの座標
Do
If IsWindowVisible(hwndC) Then
GetClassName hwndC, strClassC, Len(strClassC)
If InStr(strClassC, "AcrobatSDIWindow") <> 0 Then
DoEvents
'--------------------------------------------------------------'
'Acrobat ReaderウインドウからページビューウインドウをNameで取得'
'--------------------------------------------------------------'
Set ElmAcro = uiAuto.ElementFromHandle(ByVal hwndC)
Set ICnd = uiAuto.CreatePropertyCondition(UIA_NamePropertyId, "AVPageView")
Set ElmWin = ElmAcro.FindFirst(TreeScope_Subtree, ICnd)
'------------------------------'
'対象ウインドウがあれば選択する'
'------------------------------'
ElmWin.GetClickablePoint Mousept
SetForegroundWindow hwndC
SetCursorPos Mousept.x, Mousept.y
Call LeftClick
DoEvents
'---------------------------------------------------------------------------'
'[ctrl+c]を押下した状態でAcrobat ReaderをActivateする→PDF画像がコピーされる'
'---------------------------------------------------------------------------'
keybd_event VK_CONTROL, 0, fKEYDOWN, 0 'Controlを押す
keybd_event VK_C, 0, fKEYDOWN, 0 'Cを押す
SetForegroundWindow hwndC
keybd_event VK_C, 0, fKEYUP, 0 'Cを離す
keybd_event VK_CONTROL, 0, fKEYUP, 0 'Controlを離す
Sleep 1000
'----------------------'
'Acrobat Readerを閉じる'
'----------------------'
PostMessage hwndC, WM_CLOSE, 0, 0
Exit Do
End If
End If
hwndC = GetNextWindow(hwndC, GW_HWNDNEXT)
Loop Until hwndC = GetNextWindow(hwndC, GW_HWNDLAST) '最後のウインドウになるまで繰り返す
End Sub
Public Sub LeftClick()
mouse_event 2
mouse_event 4
End Sub
手順1:Acrobat ReaderのPDF画像が表示されている部分の要素を取得
手順2:要素をクリックしてPDF画像を全選択状態にする
手順3:Ctrl+Cを押下した状態でAcrobat Readerを最前面に持ってくることで画像をコピーする
手順4:Acrobat Readerを閉じる
改善したい部分
手順3の部分をなんとかしたいと思っています。他のアプリケーションを開いていると悪影響を及ぼしそうなので...。
※ちなみにAcrobat Readerを最前面に持ってきてSendkeysをする方法だと、1回目が20%ほどの確率で
成功し、2回目以降のコピーは失敗に終わる状況です。
以下、完成品に至るまでに考えたコードを記載します。宣言セクションとLeftClick()は完成品と共通で、メインの内容も手順3以外は基本的に同じです。
試したこと①(GetMenuAPIを利用する)
Public Sub PDFCopyEx1()
Dim hwndC As Long: hwndC = FindWindow(vbNullString, vbNullString) '1つめのウインドウを取得する
Dim strClassC As String * 60
Dim uiAuto As CUIAutomation: Set uiAuto = New CUIAutomation
Dim ElmAcro As IUIAutomationElement 'Acrobat Readerアプリケーションウインドウ
Dim ElmWin As IUIAutomationElement 'Acrobat Readerアプリケーションのページビューウインドウ
Dim ICnd As IUIAutomationCondition 'Elementを検索するための条件
Dim Mousept As tagPOINT 'マウスの座標
Dim TabMenuhwnd As Long 'AcrobatReaderのタブメニューハンドル
Dim TabMenuCount As Long 'タブメニューの個数
Dim MenuItemhwnd As Long 'タブメニュー内のメニューアイテムのハンドル
Dim MenuItemCount As Long 'メニューアイテムの個数
Dim MenuItemID As Long 'メニューアイテムのAutomationID
Dim TN As Integer
Dim MN As Integer
Do
If IsWindowVisible(hwndC) Then
GetClassName hwndC, strClassC, Len(strClassC)
If InStr(strClassC, "AcrobatSDIWindow") <> 0 Then
DoEvents
'--------------------------------------------------------------'
'Acrobat ReaderウインドウからページビューウインドウをNameで取得'
'--------------------------------------------------------------'
Set ElmAcro = uiAuto.ElementFromHandle(ByVal hwndC)
Set ICnd = uiAuto.CreatePropertyCondition(UIA_NamePropertyId, "AVPageView")
Set ElmWin = ElmAcro.FindFirst(TreeScope_Subtree, ICnd)
'----------------------------'
'対象ウインドウがあれば選択する'
'----------------------------'
ElmWin.GetClickablePoint Mousept
SetCursorPos Mousept.x, Mousept.y
Call LeftClick
'-------------------------------------'
'Acrobat Readerのタブメニュー一覧を取得'
'-------------------------------------'
TabMenuhwnd = GetMenu(hwndC)
TabMenuCount = GetMenuItemCount(TabMenuhwnd)
'--------------------------------------------------------'
'タブメニュー内のアイテムリストから[AutomationID:6056]を探す'
'--------------------------------------------------------'
For TN = 0 To TabMenuCount - 1
MenuItemhwnd = GetSubMenu(TabMenuhwnd, TN)
MenuItemCount = GetMenuItemCount(MenuItemhwnd)
For MN = 0 To MenuItemCount - 1
MenuItemID = GetMenuItemID(MenuItemhwnd, MN)
If MenuItemID = 6056 Then
GoTo SendMsgPhase
End If
Next MN
Next TN
SendMsgPhase:
'-----------------------------------------------'
'SendMessageで[AutomationID:6056]のコマンドを実行'
'-----------------------------------------------'
SendMessage hwndC, WM_COMMAND, MenuItemID, MenuItemhwnd
Sleep 1000
'----------------------'
'Acrobat Readerを閉じる'
'----------------------'
PostMessage hwndC, WM_CLOSE, 0, 0
Exit Do
End If
End If
hwndC = GetNextWindow(hwndC, GW_HWNDNEXT)
Loop Until hwndC = GetNextWindow(hwndC, GW_HWNDLAST) '最後のウインドウになるまで繰り返す
End Sub
- GetMenuでAcrobat Readerのタブメニューから"編集"タブを取得
- GetSubMenuで"編集"タブメニュー内アイテムの"コピー"[AutomationID:6056]を取得
- SendMessageでコピーを実行
2.までは問題ない(ItemIDやハンドルの取得もできている)のですが、3.を実行してもPDF画像がクリップボードにコピーされません。
試したこと②(UIAutomationのInvokePatternを利用)
Public Sub PDFCopyEx2()
Dim hwndC As Long: hwndC = FindWindow(vbNullString, vbNullString) '1つめのウインドウを取得する
Dim strClassC As String * 60
Dim uiAuto As CUIAutomation: Set uiAuto = New CUIAutomation
Dim ElmAcro As IUIAutomationElement 'Acrobat Readerアプリケーション
Dim ElmWin As IUIAutomationElement 'Acrobat Readerアプリケーションのページビューウインドウ
Dim ElmTab As IUIAutomationElement 'Acrobat Readerの編集タブ
Dim ElmMenus As IUIAutomationElement 'Acrobat Readerの編集タブ内のメニューリストボックス
Dim ElmCommand As IUIAutomationElement 'メニューリストボックス内のコピーメニュー
Dim ICnd As IUIAutomationCondition 'Elementを検索するための条件
Dim ExpandCollapsePattern As IUIAutomationExpandCollapsePattern 'ElmMenuのリストを表示するためのパターン設定
Dim InvokePattern As IUIAutomationInvokePattern 'ElmCommandを実行するためのパターン設定
Dim Mousept As tagPOINT 'マウスの座標
Dim AcceptLoop As Integer: AcceptLoop = 0
Do
If IsWindowVisible(hwndC) Then
GetClassName hwndC, strClassC, Len(strClassC)
If InStr(strClassC, "AcrobatSDIWindow") <> 0 Then
DoEvents
'--------------------------------------------------------------'
'Acrobat ReaderウインドウからページビューウインドウをNameで取得'
'--------------------------------------------------------------'
Set ElmAcro = uiAuto.ElementFromHandle(ByVal hwndC)
Set ICnd = uiAuto.CreatePropertyCondition(UIA_NamePropertyId, "AVPageView")
Set ElmWin = ElmAcro.FindFirst(TreeScope_Subtree, ICnd)
'------------------------------'
'対象ウインドウがあれば選択する'
'------------------------------'
ElmWin.GetClickablePoint Mousept
SetForegroundWindow hwndC
SetCursorPos Mousept.x, Mousept.y
Call LeftClick
DoEvents
'------------------------------------------------'
'タブメニュー[編集 (E)]のメニューリストを表示する'
'------------------------------------------------'
Set ICnd = uiAuto.CreatePropertyCondition(UIA_NamePropertyId, "アプリケーション")
Set ElmTab = ElmAcro.FindFirst(TreeScope_Children, ICnd)
Set ICnd = uiAuto.CreatePropertyCondition(UIA_AccessKeyPropertyId, "Alt+e")
Set ElmTab = ElmTab.FindFirst(TreeScope_Children, ICnd)
Set ExpandCollapsePattern = ElmTab.GetCurrentPattern(UIA_ExpandCollapsePatternId)
ExpandCollapsePattern.Expand
Sleep 300
'----------------------------------------------'
'[編集 (E)]内のメニューリストボックスを取得する'
'----------------------------------------------'
Set ICnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "#32768")
Do
Set ElmMenus = ElmAcro.FindFirst(TreeScope_Children, ICnd)
DoEvents
AcceptLoop = AcceptLoop + 1
If AcceptLoop >= 10 Then
GoTo DisFound
End If
Loop While ElmMenus Is Nothing
AcceptLoop = 0
'------------------------------------------------------'
'メニューリストボックス内の[コピー(C) Ctrl+C]を取得する'
'------------------------------------------------------'
Set ICnd = uiAuto.CreatePropertyCondition(UIA_AccessKeyPropertyId, "c")
Do
Set ElmCommand = ElmMenus.FindFirst(TreeScope_Children, ICnd)
DoEvents
AcceptLoop = AcceptLoop + 1
If AcceptLoop >= 10 Then
GoTo DisFound
End If
Loop While ElmCommand Is Nothing
'----------------------------'
'[コピー(C) Ctrl+C]を実行する'
'----------------------------'
Set InvokePattern = ElmCommand.GetCurrentPattern(UIA_InvokePatternId)
SetForegroundWindow hwndC
InvokePattern.Invoke
Sleep 1000
'----------------------'
'Acrobat Readerを閉じる'
'----------------------'
PostMessage hwndC, WM_CLOSE, 0, 0
Exit Do
End If
End If
hwndC = GetNextWindow(hwndC, GW_HWNDNEXT)
Loop Until hwndC = GetNextWindow(hwndC, GW_HWNDLAST) '最後のウインドウになるまで繰り返す
Exit Sub
DisFound:
MsgBox "見つかりませんでした"
End
End Sub
- タブメニュー内の"編集"タブを取得しExpand
- 表示されたメニューリストボックスを取得→"コピー"メニューを取得
- "コピー"メニューをInvoke
こちらも2.までは問題ないのですが、3.を実行してもクリップボードに画像が追加されません。
※ちなみに、Inspectで調べたら"編集"タブそのものはメニューリストボックス以下をChildrenに持たないようです。メニューリストボックスは、アプリケーションウインドウが直接のAncestorになるようです。私の無知もありましたが、正直驚きでした。
試したこと③(IAccessibleのDoDefaultActionを利用) ※未完成
Public Sub PDFCopyEx3()
Dim hwndC As Long: hwndC = FindWindow(vbNullString, vbNullString) '1つめのウインドウを取得する
Dim strClassC As String * 60
Dim uiAuto As CUIAutomation: Set uiAuto = New CUIAutomation
Dim ElmAcro As IUIAutomationElement 'Acrobat Readerアプリケーションウインドウ
Dim ElmWin As IUIAutomationElement 'Acrobat Readerアプリケーションのページビューウインドウ
Dim ICnd As IUIAutomationCondition 'Elementを検索するための条件
Dim Mousept As tagPOINT 'マウスの座標
Dim TabMenuhwnd As Long 'AcrobatReaderのタブメニューハンドル
Dim TabMenuCount As Long 'タブメニューの個数
Dim MenuItemhwnd As Long 'タブメニュー内のメニューアイテムのハンドル
Dim MenuItemCount As Long 'メニューアイテムの個数
Dim MenuItemID As Long 'メニューアイテムのAutomationID
Dim TN As Integer
Dim MN As Integer
Dim IID(0 To 3) As Long
Dim CopyMenu As IAccessible
Do
If IsWindowVisible(hwndC) Then
GetClassName hwndC, strClassC, Len(strClassC)
If InStr(strClassC, "AcrobatSDIWindow") <> 0 Then
DoEvents
'--------------------------------------------------------------'
'Acrobat ReaderウインドウからページビューウインドウをNameで取得'
'--------------------------------------------------------------'
Set ElmAcro = uiAuto.ElementFromHandle(ByVal hwndC)
Set ICnd = uiAuto.CreatePropertyCondition(UIA_NamePropertyId, "AVPageView")
Set ElmWin = ElmAcro.FindFirst(TreeScope_Subtree, ICnd)
'------------------------------'
'対象ウインドウがあれば選択する'
'------------------------------'
ElmWin.GetClickablePoint Mousept
SetCursorPos Mousept.x, Mousept.y
Call LeftClick
'--------------------------------------'
'Acrobat Readerのタブメニュー一覧を取得'
'--------------------------------------'
TabMenuhwnd = GetMenu(hwndC)
TabMenuCount = GetMenuItemCount(TabMenuhwnd)
'--------------------------------------------------------------'
'タブメニュー内のアイテムリストから[AutomationID:6056]を探す'
'--------------------------------------------------------------'
For TN = 0 To TabMenuCount - 1
MenuItemhwnd = GetSubMenu(TabMenuhwnd, TN)
MenuItemCount = GetMenuItemCount(MenuItemhwnd)
For MN = 0 To MenuItemCount - 1
MenuItemID = GetMenuItemID(MenuItemhwnd, MN)
If MenuItemID = 6056 Then
GoTo SendMsgPhase
End If
Next MN
Next TN
SendMsgPhase:
'##########
'未完成部分#
'######################################################################################
IIDFromString StrPtr("{AC76BA86-7AD7-1041-7B44-AC0F074E4100}"), IID(0) 'IID_IAccessible
AccessibleObjectFromWindow hwndC, OBJID_WINDOW, IID(0), CopyMenu
If CopyMenu Is Nothing Then Exit Sub
'#####################################################################################
'----------------------'
'Acrobat Readerを閉じる'
'----------------------'
PostMessage hwndC, WM_CLOSE, 0, 0
Exit Do
End If
End If
hwndC = GetNextWindow(hwndC, GW_HWNDNEXT)
Loop Until hwndC = GetNextWindow(hwndC, GW_HWNDLAST) '最後のウインドウになるまで繰り返す
End Sub
すみません。ネット上の情報を探し回ったのですがなかなか情報が見つからず...また私自身のGUID/UUIDに対する知識不足もありコードを書けませんでした。
UIAutomationのInvokeだと実行できないコマンドをIAccesibleのDoDefaultActionで代用するという情報があったのでやってみようと思いました。
考えていた流れとしては以下になります。
- GetMenuAPI関連で編集メニュー内のハンドルを取得
- AccessibleObjectFromWindowAPIでIAccessibleオブジェクトを取得
- IAccessibleオブジェクトからChildID:5でコピーメニューを取得
- DoDefaultActionを実行
※IID取得の部分のGUIDはAdobe Acrobat ReaderのJPN版のGUIDのはずです...(レジストリエディタで調べた結果)
質問内容
Ⅰ. ExcelワークシートにPDF画像を貼り付ける方法の中で、最適なもの(解像度をできるだけ落とさずに)
Ⅱ. 試したこと①、試したこと②が機能しない原因
Ⅲ. 試したこと③の方法で実行する場合のソースコード
どれか一つでも構いませんので、ご教授いただければ幸いです。よろしくお願いいたします。
Acrobat SDK によって開発されたプラグインやアプリケーションの再配布には、一切の費用は発生いたしません。
調べる価値はありそうです。