| |
▼KAO さん：
>▼neptune さんの
>>Shell関数はプロセスIDが返ってきたと思いますから、EnumWindowsで、
>>プロセスIDを検索して、lnghWnd を取得する方法が・・・・
第二弾です。
Option Explicit
Private Declare Function EnumWindows Lib "user32.dll" _
(ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hWnd As Long, _
lpdwProcessId As Long) As Long
Private Declare Function GetParent Lib "user32" _
(ByVal hWnd As Long) As Long
' ウィンドウの表示状態
Private Declare Function IsWindowVisible Lib "user32" _
(ByVal hWnd As Long) As Long
' ウィンドウのクラス名
Private Declare Function GetClassName Lib "user32.dll" _
Alias "GetClassNameA" _
(ByVal hWnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
' ウィンドウテキスト
Private Declare Function GetWindowText Lib "user32.dll" _
Alias "GetWindowTextA" _
(ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal nMaxCount As Long) As Long
'ウインドウ文字列の長さ
Private Declare Function GetWindowTextLength Lib "user32" _
Alias "GetWindowTextLengthA" _
(ByVal hWnd As Long) As Long
'ウインドウ設定値
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_SYSMENU = &H80000
Private Const WS_BORDER = &H800000
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
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 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
Private 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
' コールバック関数
Function EnumWindowsProc(ByVal hWnd As Long, _
ByVal lParam As Long) As Long
Dim strWindowClassNameBuff As String * 128
Dim strWindowTextBuff As String * 516
Dim lngRtnCode As Long
Dim lngThreadId As Long
Dim lngProcesID As Long
Dim lngStyle As Long
Dim lngRow As Long
Dim strClass As String
Dim strText As String
'表示状態
If IsWindowVisible(hWnd) = 0 Then GoTo EnumPass
'親ウインドウ
If GetParent(hWnd) <> 0 Then GoTo EnumPass
'タイトルバー文字長さ
If GetWindowTextLength(hWnd) = 0 Then GoTo EnumPass
lngStyle = GetWindowLong(hWnd, GWL_STYLE)
'システムメニュー
If Not lngStyle And WS_SYSMENU Then GoTo EnumPass
'境界線
If Not lngStyle And WS_BORDER Then GoTo EnumPass
lngThreadId = GetWindowThreadProcessId(hWnd, lngProcesID)
If lParam = lngProcesID Then
' クラス名をバッファに
lngRtnCode = GetClassName(hWnd, _
strWindowClassNameBuff, _
Len(strWindowClassNameBuff))
' クラス名取得
strClass = left(strWindowClassNameBuff, _
InStr(strWindowClassNameBuff, _
vbNullChar) - 1)
' タイトルバーテキストをバッファに
lngRtnCode = GetWindowText(hWnd, _
strWindowTextBuff, _
Len(strWindowTextBuff))
' タイトルバーテキスト表示
strText = left(strWindowTextBuff, _
InStr(strWindowTextBuff, _
vbNullChar) - 1)
lnghWnd = hWnd
' 此処のコメントを外すと 下記のデータがイミディエイトウィンドウに表示
' Debug.Print "Window Handle = " & hWnd, "ClassName = " & strClass, "Window Text = " & strText
EnumWindowsProc = False
Exit Function
End If
' 列挙を継続
EnumPass:
EnumWindowsProc = True
End Function
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\Acrobat 7.0\Acrobat\Acrobat.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
' Application.Wait Now + TimeValue("0:00:03")
lnghWnd = 0
lngRtn = EnumWindows(AddressOf EnumWindowsProc, ByVal lngTaskId)
' EnumWindowのコールバックで表示した時 ClassName = AcrobatSDIWindow ← に表示されたものを
' ↓ に入れれば EnumWindows のコールは要らなくなります。
' strClass = "AcrobatSDIWindow"
' Debug.Print Hex(FindWindow(strClass, vbNullString)), Hex(lnghWnd)
If lnghWnd = 0 Then Exit Sub
' PDF を画面右半分
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
' エクセルを最大表示
lngRtn = SetWindowPos(Application.hWnd, _
0, _
0, _
0, _
lngX * 2, _
lngY, _
SWP_NOZORDER Or _
SWP_NOACTIVATE)
' Application.WindowState = xlMaximized
' Application.WindowState = xlNormal
End Sub
|
|
Yuki
- 09/1/22(木) 11:49 -
