| |
▼KAO さん：
>エクセルのファイルとPDFのファイルを並べてウインドウに表示させたいのですが、うまくいきません。
>アドバイスをいただけないでしょうか？
下記のコードはPDFファイルを開いて画面半分表示、
エクセルも画面半分表示してPDFを閉じるものです。
エクセルのツールー＞マクロから実行してみてください。
エクセルは自ブックが対象です。
Option Explicit
Private Declare Function SetWindowPos Lib "user32.dll" _
(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 SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOMOVE = &H2
Public 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 Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const SM_CXFULLSCREEN = 16
Private Const SM_CYFULLSCREEN = 17
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" _
(ByVal hProcess As Long, _
ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Private Const PROCESS_TERMINATE = &H1
Private Const PROCESS_QUERY_INFORMATION = &H400
Public Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Const WM_CLOSE = &H10
Private Declare Function GetWindowRect Lib "user32.dll" _
(ByVal hwnd As Long, _
lpRect As RECT) As Long
' 座標
Private Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Dim lnghWnd As Long
Dim lngTaskId As Long
' ウィンドウ（アプリケーション）の終了
Sub AppExit()
Dim lngRtn As Long
lngRtn = PostMessage(lnghWnd, WM_CLOSE, ByVal 0&, ByVal 0&)
End Sub
' 強制終了
Sub TerminateExit()
Dim lngHdl As Long
Dim lngExitCode As Long
Dim lngRtn As Long
lngHdl = OpenProcess(PROCESS_QUERY_INFORMATION Or _
PROCESS_TERMINATE, 0, lngTaskId)
lngRtn = GetExitCodeProcess(lngHdl, lngExitCode)
lngRtn = TerminateProcess(lngHdl, lngExitCode)
lngRtn = CloseHandle(lngHdl)
End Sub
Sub WindowSizeChg()
Dim strClass As String
Dim pdfRECT As RECT
Dim xlsRECT As RECT
Dim lngRtn As Long
Dim lngX As Long
Dim lngY As Long
Dim strEXE As String
Dim strPDF As String
strPDF = "D:\hogehoge.pdf"
strEXE = "C:\Program Files\Adobe\Reader 8.0\Reader\AcroRd32.exe "
lngTaskId = Shell(strEXE & strPDF, 3)
' ' 起動待ち
On Error Resume Next
Do
DoEvents
Err.Clear
AppActivate lngTaskId
Loop Until Err.Number = 0
On Error GoTo 0
' PDF を画面右半分
strClass = "AcrobatSDIWindow"
lnghWnd = FindWindow(strClass, vbNullString)
If lnghWnd = 0 Then Exit Sub
GetWindowRect lnghWnd, pdfRECT
With pdfRECT
lngY = (.bottom - .top)
lngX = (GetSystemMetrics(16) / 2)
'x 幅 y 高さ
lngRtn = SetWindowPos(lnghWnd, _
0, _
lngX, _
0, _
lngX, _
lngY, _
SWP_NOZORDER Or _
SWP_NOACTIVATE)
End With
' Excelを画面左半分
GetWindowRect Application.hwnd, xlsRECT
With xlsRECT
lngY = (.bottom - .top)
lngX = (GetSystemMetrics(16) / 2)
'x 幅 y 高さ
lngRtn = SetWindowPos(Application.hwnd, _
0, _
0, _
0, _
lngX, _
lngY, _
SWP_NOZORDER Or _
SWP_NOACTIVATE)
End With
' 待ち時間
Application.Wait Now + TimeValue("0:00:03")
' PDF 終了 下記2行のうちどちらかを実行
' Call TerminateExit
Call AppExit
' エクセルを最大表示
Application.WindowState = xlMaximized
End Sub
|
|
Yuki
- 09/1/14(水) 17:24 -
