電帳法索引簿などで使える？＿VBA（64bitのみ）・指定したファイルが開くまで待ってAppActivateしたのち、ウィンドウサイズをAPIでリサイズするコード。結局Sleep関数で待つことが必要だったけど、２秒も３秒も待たなくてよくなったので（0.5秒でOKになったので）、暫定的にこれを使う。（本当はもっとちゃんとしたコードがあるはず。でもなかなか検索にヒットしないのでひとまずこれで。）

目次
★ 64bit「専用」の１つめのモジュール
 ★ 64bit「専用」、ウィンドウサイズのリサイズ用のAPIモジュール
 ★ 32bit用 Only の２つのモジュール
 ★ 64bit/32bit「兼用」の２つのモジュール

https://liclog.net/getwindowtext-function-vba-api/
を参考に少し書き変えただけのものです。

Web検索すると、『「開くファイル」に対してではなく、「空白の状態で起動するソフト」大して＝起動するソフトのフルパスのみに対して、だけのAPIでの待機」でしかなくて、
そればっかりでした。

「拡張子に紐付いたソフトで起動されたファイル」を「開くのを待機するAPI」が
なかなか検索にヒットしません。（自分では見つけられませんでした。）

なので、とりあえず、これで代用です。

結局Sleep関数で待ち時間を入れていますが、ただ、他のWebのサンプルのように
２秒も３秒も待たなくていいのでひとまず使えそうです。

ただし、最低限0.5～0.8秒くらいは待たないといけないかもしれません。
HDDの遅いパソコンだと1秒以上、待たないといけないかも？です。
（※そもそも起動が遅いソフトの、その起動秒数は含まれません。）

なお、今回のサンプルでは、以降の２つのモジュールが必要です。
最初のモジュールだけだと動きません。
（ウィンドウリサイズができないので。２つめのモジュールがウィンドウリサイズ用です。）

※もし動きが安定しなかったらりファイルが壊れやすくなったら、
　xlsmじゃなくて、xlsでやると安定するっぽいです。
　　

●指定したファイルを、拡張子に関連づいたソフトで起動して、そのウィンドウサイズをリサイズするモジュール（64bit用のAPI含む。32bitでも行けるかも？）

「FileBoot01」プロシージャにて、で、呼び出します。
つまり、「Call FileBoot01(”ファイルフルパス”)」と書いて呼び出します。
すると、そのファイルのウィンドウが「app_window_risize01」関数により、
指定したサイズにリサイズされます。

開くのが遅いソフトでも、おおむね大丈夫っぽいです。

app_window_risize01関数は、２つめのモジュールに書かれているので
２つめのモジュールもVBEにコピペします。標準モジュールでOKです。

◆◆◆◆注意！！！！◆◆◆◆
32bit用（64bit兼用の中の32bit用も含む）のほうで、ウィンドウタイトルの取得のところで、
・実際のウィンドウタイトルのファイル名部分に『　[　]　』があったりなかったり
・変数内も『　[　]　』があったりなかったり、
といった現象が起こり、エラーになることがありました。
特にOSがWindows2000などの古いものの場合。
その場合は、それを回避するコードが必要か、あきらめるか、になると思います。
OSがWin10などの、32bitExcelなら多分大丈夫かと思うのですが・・・。

※原因は、ファイルのオープン（起動）を『 CreateObject("Shell.Application") 』でやってるから？かもしれません。未確認です。
『 CreateObject("Shell.Application") 』を使ったのは、「拡張子に紐付いたアプリケーションでちゃんと開く」ということをしたかったためです。
他の方法だと、マシンによっては、なぜか、「アクロバットに紐付いているいのにブラウザでPDFが開いてしまう」というマシンがあったりと「開くソフトがバラバラ」だったので。

＝＝＝＝＝＝＝＝＝＝＝＝

★ 64bit「専用」の１つめのモジュール

'
'
Option Explicit

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)
'↑「Sleep」関数で、ミリ秒、待つためのAPIコード。


#If Win64 Then
 '【GetNextWindow関数】
    Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" _
    (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
 
 '【IsWindowVisible関数】
    Declare PtrSafe Function IsWindowVisible Lib "user32" _
    (ByVal hwnd As LongPtr) As LongPtr
 
 '【GetWindowText関数】
    Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As LongPtr
 
 '【FindWindow関数】
    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
 
    Dim hwnd As LongPtr
    
#Else
 '【GetNextWindow関数】
    Declare Function GetNextWindow Lib "user32" Alias "GetWindow" _
    (ByVal hwnd As Long, ByVal wFlag As Long) As Long
 
 '【IsWindowVisible関数】
    Declare Function IsWindowVisible Lib "user32" _
    (ByVal hwnd As Long) As Long
 
 '【GetWindowText関数】
    Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
 
 '【FindWindow関数】
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
    Dim hwnd As Long
 
#End If
 
Const GW_HWNDLAST = 1
Const GW_HWNDNEXT = 2

'-------------------------------------------------------------------------------------
'APIのWebページ付属のサンプルプログラム
'今回は、これを無理矢理に関数化しました。
'-------------------------------------------------------------------------------------
Sub main()
 
   
    Dim strCaption As String * 500
    
    hwnd = FindWindow(vbNullString, vbNullString)
    
    Dim caps As Collection
    Set caps = New Collection
    Dim cap 'As String
    Do
        If IsWindowVisible(hwnd) Then
        
            GetWindowText hwnd, strCaption, Len(strCaption)
            
            cap = Left(strCaption, InStr(strCaption, vbNullChar) - 1)
            If cap <> "" Then
                caps.Add cap
            End If
            
        End If
    
        hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)
    
    Loop Until hwnd = GetNextWindow(hwnd, GW_HWNDLAST)
    
    For Each cap In caps
        Debug.Print cap
    Next cap
 
End Sub


'###################################################################################
'ファイルの起動＋関数の呼び出し事例プログラム
'###################################################################################

Function FileBoot01(s_FilePath01 As String)

    Dim s_WindowTitle As String
    
    
    'ファイルを起動。
    With CreateObject("Shell.Application")
        .ShellExecute s_FilePath01
    End With
    
    
    
'    ' 起動を待つ  ’旧バージョンン。ダメだった。使えない。
'    Do Until objShell.AppActivate(objExec.ProcessID)
'        Sleep 1000
'        DoEvents
'        Debug.Print objExec.ProcessID
'        Debug.Print objShell.AppActivate(objExec.ProcessID)
'    Loop


    s_WindowTitle = WindowTitleGet01(Dir(s_FilePath01))
    '↑ウィンドウタイトルを取得。
    '　この「WindowTitleGet01」関数である程度、起動を「待つ」。
    
    Debug.Print s_WindowTitle & "-----★本番データ"
    
    Sleep 500     '（API）
    '↑さらに少し待つと、確実？なのか？
    '　とりあえず２秒も、３秒も待たなくて良い・・・、っぽい。
    
    
    AppActivate s_WindowTitle
    '↑ 目的のウィンドウタイトルのウィンドウをアクティブにする
    '　本当に効いているのかは少々疑問。
    '　　→コメントアウトしてテストしたら動かなかったので、結果、効いていたことになる。
    '　ただ、もしかしたら、場合によってはこのコード無くてもOKなケースもあるかもしれない。（未調査）
    
    
'    Debug.Print WindowTitleGet01(Dir(s_FilePath01)) & "---(A)"
    
    
    
'    Call app_window_risize01(0, 10, 300, 650)
    Call app_window_risize01(501, 10, 780, 650)
    '↑目的のウィンドウのリサイズ。
    
    
'    AppActivate WindowTitleGet01("ドラッグ")
'    Debug.Print WindowTitleGet01("ドラッグ")
'    '↑とりあえずのテストをしただけ。コメントアウト。

    
End Function

'###################################################################################
'ファイルの起動＋関数の呼び出し事例プログラム
'###################################################################################


Function WindowTitleGet01(s_ChkWord01 As String) As String

    Dim strCaption As String * 500
    '長さ500の文字列型変数の宣言
    
    Do
   
        strCaption = ""
        
        hwnd = FindWindow(vbNullString, vbNullString)
        
        
        '↓コレクションの生成
        Dim caps As Collection
        Dim cap 'As String
        Set caps = New Collection
        Do
            If IsWindowVisible(hwnd) Then
            
                GetWindowText hwnd, strCaption, Len(strCaption)
                
                cap = Left(strCaption, InStr(strCaption, vbNullChar) - 1)
                If cap <> "" Then
                    caps.Add cap
                End If
                
            End If
        
            hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)
        
        Loop Until hwnd = GetNextWindow(hwnd, GW_HWNDLAST)
        '↑コレクションの生成
        
        
        
        For Each cap In caps
        
'            Debug.Print cap & "---WTG-Function"
            
            If 1 <= InStr(1, cap, s_ChkWord01, vbBinaryCompare) Then
                WindowTitleGet01 = cap
                Set caps = Nothing
                Exit Function
            Else
            
            End If
        Next cap
        '↑コレクションの中に目的の検索文言を含むウィンドウタイトルがあるか調べ、
        '　あったらユーザーにそれを返してプロシージャも終わる。
        
        Set caps = Nothing
        'コレクションの消滅
    
    Loop
    
End Function
'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

Option Explicit

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)

'↑「Sleep」関数で、ミリ秒、待つためのAPIコード。

#If Win64 Then

'【GetNextWindow関数】

Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" _

(ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr

'【IsWindowVisible関数】

Declare PtrSafe Function IsWindowVisible Lib "user32" _

(ByVal hwnd As LongPtr) As LongPtr

'【GetWindowText関数】

Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _

(ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As LongPtr

'【FindWindow関数】

Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _

(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Dim hwnd As LongPtr

#Else

'【GetNextWindow関数】

Declare Function GetNextWindow Lib "user32" Alias "GetWindow" _

(ByVal hwnd As Long, ByVal wFlag As Long) As Long

'【IsWindowVisible関数】

Declare Function IsWindowVisible Lib "user32" _

(ByVal hwnd As Long) As Long

'【GetWindowText関数】

Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _

(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

'【FindWindow関数】

Declare Function FindWindow Lib "user32" Alias "FindWindowA" _

(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Dim hwnd As Long

#End If

Const GW_HWNDLAST = 1

Const GW_HWNDNEXT = 2

'-------------------------------------------------------------------------------------

'APIのWebページ付属のサンプルプログラム

'今回は、これを無理矢理に関数化しました。

'-------------------------------------------------------------------------------------

Sub main()

Dim strCaption As String * 500

hwnd = FindWindow(vbNullString, vbNullString)

Dim caps As Collection

Set caps = New Collection

Dim cap 'As String

If IsWindowVisible(hwnd) Then

GetWindowText hwnd, strCaption, Len(strCaption)

cap = Left(strCaption, InStr(strCaption, vbNullChar) - 1)

If cap <> "" Then

caps.Add cap

End If

hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)

Loop Until hwnd = GetNextWindow(hwnd, GW_HWNDLAST)

For Each cap In caps

Debug.Print cap

Next cap

End Sub

'###################################################################################

'ファイルの起動＋関数の呼び出し事例プログラム

'###################################################################################

Function FileBoot01(s_FilePath01 As String)

Dim s_WindowTitle As String

'ファイルを起動。

With CreateObject("Shell.Application")

.ShellExecute s_FilePath01

End With

' ' 起動を待つ ’旧バージョンン。ダメだった。使えない。

' Do Until objShell.AppActivate(objExec.ProcessID)

' Sleep 1000

' DoEvents

' Debug.Print objExec.ProcessID

' Debug.Print objShell.AppActivate(objExec.ProcessID)

' Loop

s_WindowTitle = WindowTitleGet01(Dir(s_FilePath01))

'↑ウィンドウタイトルを取得。

'　この「WindowTitleGet01」関数である程度、起動を「待つ」。

Debug.Print s_WindowTitle & "-----★本番データ"

Sleep 500 '（API）

'↑さらに少し待つと、確実？なのか？

'　とりあえず２秒も、３秒も待たなくて良い・・・、っぽい。

AppActivate s_WindowTitle

'↑ 目的のウィンドウタイトルのウィンドウをアクティブにする

'　本当に効いているのかは少々疑問。

'　　→コメントアウトしてテストしたら動かなかったので、結果、効いていたことになる。

'　ただ、もしかしたら、場合によってはこのコード無くてもOKなケースもあるかもしれない。（未調査）

' Debug.Print WindowTitleGet01(Dir(s_FilePath01)) & "---(A)"

' Call app_window_risize01(0, 10, 300, 650)

Call app_window_risize01(501, 10, 780, 650)

'↑目的のウィンドウのリサイズ。

' AppActivate WindowTitleGet01("ドラッグ")

' Debug.Print WindowTitleGet01("ドラッグ")

' '↑とりあえずのテストをしただけ。コメントアウト。

End Function

'###################################################################################

'ファイルの起動＋関数の呼び出し事例プログラム

'###################################################################################

Function WindowTitleGet01(s_ChkWord01 As String) As String

Dim strCaption As String * 500

'長さ500の文字列型変数の宣言

strCaption = ""

hwnd = FindWindow(vbNullString, vbNullString)

'↓コレクションの生成

Dim caps As Collection

Dim cap 'As String

Set caps = New Collection

If IsWindowVisible(hwnd) Then

GetWindowText hwnd, strCaption, Len(strCaption)

cap = Left(strCaption, InStr(strCaption, vbNullChar) - 1)

If cap <> "" Then

caps.Add cap

End If

hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)

Loop Until hwnd = GetNextWindow(hwnd, GW_HWNDLAST)

'↑コレクションの生成

For Each cap In caps

' Debug.Print cap & "---WTG-Function"

If 1 <= InStr(1, cap, s_ChkWord01, vbBinaryCompare) Then

WindowTitleGet01 = cap

Set caps = Nothing

Exit Function

Else

End If

Next cap

'↑コレクションの中に目的の検索文言を含むウィンドウタイトルがあるか調べ、

'　あったらユーザーにそれを返してプロシージャも終わる。

Set caps = Nothing

'コレクションの消滅

Loop

End Function

★ 64bit「専用」、ウィンドウサイズのリサイズ用のAPIモジュール

app_window_risize01関数はここから呼び出します。
32bitには対応していませんので、対応させたいならその分の追記が必要です。

'
'
Option Explicit

'●Win64API　ウィンドウの最大化、最小化、等、状態の取得用の定義

Public Const SW_HIDE = 0
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWNORMAL = 1

'Type RECT
'    Left As Long
'    Top As Long
'    Right As Long
'    Bottom As Long
'End Type

'Type POINTAPI
'    X As Long
'    Y As Long
'End Type

'Type WINDOWPLACEMENT
'    Length As Long
'    Flags As Long
'    ShowCmd As Long
'    PtMinPosition As POINTAPI
'    PtMaxPosition As POINTAPI
'    RcNormalPosition As RECT
'End Type

Public Const WPF_RESTORETOMAXIMIZED = &H2
Public Const WPF_SETMINPOSITION = &H1

'Declare Function GetWindowPlacement Lib "user32" (ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long


'●Win64API　ウィンドの大きさ変更用の定義

Public Declare PtrSafe Function GetForegroundWindow _
    Lib "user32" () As Long

Public Type POINTAPI
    X As Long
    Y As Long
End Type

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Type WINDOWPLACEMENT
    Length As Long
    Flags As Long
    ShowCmd As Long
    PtMinPosition As POINTAPI
    PtMaxPosition As POINTAPI
    RcNormalPosition As RECT
End Type

Public Declare PtrSafe Function GetWindowPlacement Lib "user32" (ByVal hwnd As LongPtr, lpwndpl As WINDOWPLACEMENT) As Long
Public Declare PtrSafe Function SetWindowPlacement Lib "user32" (ByVal hwnd As LongPtr, lpwndpl As WINDOWPLACEMENT) As Long



'●Win64API　ウィンドウの最前面表示用の定義
                                          
 Declare PtrSafe Function FindWindow% Lib "user32" Alias "FindWindowA" _
                                          (ByVal lpClassName As Any, _
                                           ByVal lpCaption As Any)

'■「名前が適切ではありません」のエラーが出るので、コメントアウト。
'　　　（どことかぶってるかは未チェックです。多分、１つ目のモジュールの
'        64bitの分岐の「Declare PtrSafe Function FindWindow」。）
'  Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
'  (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
'

 Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, _
                                 ByVal hWndInsertAfter As LongPtr, _
                                 ByVal X As Long, _
                                 ByVal Y As Long, _
                                 ByVal cx As Long, _
                                 ByVal cy As Long, _
                                 ByVal wFlags As Long) As Long


Global Const HWND_TOPMOST = -1   ' 最全面に表示する
Global Const HWND_NOTOPMOST = -2 ' 最前面に表示するのをやめる
Global Const SWP_NOSIZE = &H1    ' サイズを変更しない
Global Const SWP_NOMOVE = &H2    ' 位置を変更しない



'##########　　Win64APIの呼び出しはここまで　　################################################

'##########　　以下、Win64APIを呼び出すための関数（Win64APIを利用するための関数）　　################################################




'######################################################################################
'他のmdbのウィンドウを最前面にする関数
'win_hwnd には、「objAccess.hWndAccessApp」などで取得したウィンドウハンドルの値（Long型）を渡す
'hwndは Handle Of Window の略
'######################################################################################

Function window_most_top_on(win_hwnd As Long)

   Call SetWindowPos(win_hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

End Function

'######################################################################################
'他のmdbのウィンドウの最前面を解除する関数
'win_hwnd には、「objAccess.hWndAccessApp」などで取得したウィンドウハンドルの値（Long型）を渡す
''hwndは Handle Of Window の略
'######################################################################################


Function window_most_top_off(win_hwnd As Long)

   Call SetWindowPos(win_hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

End Function


'#################################################################
'自mdbを最前面に強制表示。
'#################################################################
Sub MeMdbSaiZenmenOn()
   Dim objAccess As Access.Application
   Set objAccess = CurrentProject.Application
   Call window_most_top_on(objAccess.hWndAccessApp)
End Sub

'#################################################################
'自mdbの最前面を強制表示解除。
'#################################################################
Sub MeMdbSaiZenmenOFF()
   Dim objAccess As Access.Application
   Set objAccess = CurrentProject.Application
   Call window_most_top_off(objAccess.hWndAccessApp)
End Sub


'######################################################################################

'●上記関数の呼び出しの使用例のコード
Sub testtest()
   Dim objAccess As Access.Application
   Set objAccess = CurrentProject.Application
   Call window_most_top_off(objAccess.hWndAccessApp)
End Sub

'######################################################################################

'●(02)自mdbを最前面にする使用例のコード
Sub test101()

   Dim objAccess As Access.Application
   Set objAccess = CurrentProject.Application
   Call SetWindowPos(objAccess.hWndAccessApp, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
   Set objAccess = Nothing
End Sub



'●(03)自mdbの最前面を解除する使用例のコード

Sub test102()
   Dim objAccess As Access.Application
   Set objAccess = CurrentProject.Application
   Call SetWindowPos(objAccess.hWndAccessApp, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
   Set objAccess = Nothing
End Sub


'###################################################################
'開いた何らかのアプリケーションをリサイズする関数
'タイトル名からリサイズする。
'タイトル名は全部じゃなくても一部でもOKみたいです。
'###################################################################

Function app_window_risize_for_title_name(active_title_name As String, _
                                          left_position As Integer, _
                                          Top_position As Integer, _
                                          Width_length As Integer, _
                                          Height_length As Integer)

    Dim myHwnd As LongPtr
    Dim myWindowPlacement As WINDOWPLACEMENT


    '対象をアクティブにする。アクティブにしないと動かない。
'    AppActivate active_title_name
'    AppActivate "TeraPad"
    
    'ウィンドウハンドルの取得
    myHwnd = GetForegroundWindow()
    Debug.Print "myHwnd01---" & myHwnd   '★★★★★★★★★★★★★★★
    
    'ウィンドウ情報の取得
    GetWindowPlacement myHwnd, myWindowPlacement
    'ウィンドウ情報を変更して設定
    With myWindowPlacement.RcNormalPosition
        .Left = left_position
        .Top = Top_position
        .Right = Width_length + left_position
        .Bottom = Height_length + Top_position
    End With
    
    Debug.Print "myHwnd02---" & myHwnd
    SetWindowPlacement myHwnd, myWindowPlacement

End Function



'###################################################################
'開いた何らかのアプリケーションをリサイズする関数。
'タスクID(プロセスID）からリサイズする。
'
'###################################################################

Function app_window_risize_for_p_id(p_id As Integer, _
                                    left_position As Integer, _
                                    Top_position As Integer, _
                                    Width_length As Integer, _
                                    Height_length As Integer)

    Dim myHwnd As LongPtr
    Dim myWindowPlacement As WINDOWPLACEMENT


    '対象をアクティブにする。アクティブにしないと動かない。
    AppActivate p_id

    'ウィンドウハンドルの取得
    myHwnd = GetForegroundWindow()
    'ウィンドウ情報の取得
    GetWindowPlacement myHwnd, myWindowPlacement
    'ウィンドウ情報を変更して設定
    With myWindowPlacement.RcNormalPosition
        .Left = left_position
        .Top = Top_position
        .Right = Width_length + left_position
        .Bottom = Height_length + Top_position
    End With
    SetWindowPlacement myHwnd, myWindowPlacement

End Function



'###################################################################
'単純に自mdbのみをリサイズする関数。
'
'
'###################################################################

Function app_window_risize01(left_position As Integer, _
                                    Top_position As Integer, _
                                    Width_length As Integer, _
                                    Height_length As Integer)

    Dim myHwnd As Long
    Dim myWindowPlacement As WINDOWPLACEMENT

'
'    '対象をアクティブにする。アクティブにしないと動かない。
'    AppActivate p_id  ’←エラーになるのでコメントアウト。

    'ウィンドウハンドルの取得
    myHwnd = GetForegroundWindow()
    'ウィンドウ情報の取得
    GetWindowPlacement myHwnd, myWindowPlacement
    'ウィンドウ情報を変更して設定
    With myWindowPlacement.RcNormalPosition
        .Left = left_position
        .Top = Top_position
        .Right = Width_length + left_position
        .Bottom = Height_length + Top_position
    End With
    SetWindowPlacement myHwnd, myWindowPlacement

End Function



Function app_window_risize02(l_GetForegroundWindowNumber, _
                                    left_position As Integer, _
                                    Top_position As Integer, _
                                    Width_length As Integer, _
                                    Height_length As Integer)

    Dim myHwnd As Long
    Dim myWindowPlacement As WINDOWPLACEMENT

'
'    '対象をアクティブにする。アクティブにしないと動かない。
'    AppActivate p_id

    'ウィンドウハンドルの取得
'    myHwnd = GetForegroundWindow()
    myHwnd = l_GetForegroundWindowNumber
    'ウィンドウ情報の取得
    GetWindowPlacement myHwnd, myWindowPlacement
    'ウィンドウ情報を変更して設定
    With myWindowPlacement.RcNormalPosition
        .Left = left_position
        .Top = Top_position
        .Right = Width_length + left_position
        .Bottom = Height_length + Top_position
    End With
    SetWindowPlacement myHwnd, myWindowPlacement

End Function


'###################################################################
'開いているmdb内のフォームをリサイズする関数
'上記関数を変形しただけ。
'フォーム名をモトにリサイズする。
'
'###################################################################

Function form_api_risize(active_form_name As String, _
                         left_position As Integer, _
                         Top_position As Integer, _
                         Width_length As Integer, _
                         Height_length As Integer)

    Dim myHwnd As Long
    Dim myWindowPlacement As WINDOWPLACEMENT



    'フォームのウィンドウハンドルの取得
     myHwnd = Forms(active_form_name).hwnd

    'ウィンドウ情報の取得
    GetWindowPlacement myHwnd, myWindowPlacement

    'ウィンドウ情報を変更して設定
    With myWindowPlacement.RcNormalPosition
        .Left = left_position
        .Top = Top_position
        .Right = Width_length + left_position
        .Bottom = Height_length + Top_position
    End With
    SetWindowPlacement myHwnd, myWindowPlacement

End Function

'################################################################################
'フォームの状態を調べる関数（最大化、最小化、通常、非表示）
'hWnd01 はウィンドウハンドルを指定する。Me.Hwnd など。
'
'################################################################################

Function frm_size_State01(hWnd01 As Long) As String

    Dim lRet As Long
    Dim lpWnd As WINDOWPLACEMENT
    Dim str01 As String

    With lpWnd
        .Length = LenB(lpWnd)
        lRet = GetWindowPlacement(hWnd01, lpWnd)

        'str01 = "フォームの表示状態："
        If lRet <> 0 Then
            If .ShowCmd = SW_SHOWMINIMIZED Then
'                str01 = str01 & "最小化サイズ" & vbCrLf
                frm_size_State01 = "最小"
            ElseIf .ShowCmd = SW_SHOWMAXIMIZED Then
'                str01 = str01 & "最大化サイズ" & vbCrLf
                frm_size_State01 = "最大"
            ElseIf .ShowCmd = SW_SHOWNORMAL Then
'                str01 = str01 & "通常サイズ" & vbCrLf
                frm_size_State01 = "通常"
            ElseIf .ShowCmd = SW_HIDE Then
'                str01 = str01 & "非表示" & vbCrLf
                frm_size_State01 = "非表示"
            Else
'                str01 = str01 & "不明" & vbCrLf
                frm_size_State01 = "不明"
            End If

        Else
'            str01 = str01 & "取得エラー" & vbCrLf
                frm_size_State01 = "取得エラー"
        End If
    End With

End Function

'###################################################################
'上のコードの土台
'###################################################################

Function frm_size_State01_test(hWnd01 As Long)

    Dim lRet As Long
    Dim lpWnd As WINDOWPLACEMENT
    Dim str01 As String

    With lpWnd
        .Length = LenB(lpWnd)
        lRet = GetWindowPlacement(hWnd01, lpWnd)

        str01 = "フォームの表示状態："
        If lRet <> 0 Then
            If .ShowCmd = SW_SHOWMINIMIZED Then
                str01 = str01 & "最小化サイズ" & vbCrLf
            ElseIf .ShowCmd = SW_SHOWMAXIMIZED Then
                str01 = str01 & "最大化サイズ" & vbCrLf
            ElseIf .ShowCmd = SW_SHOWNORMAL Then
                str01 = str01 & "通常サイズ" & vbCrLf
            ElseIf .ShowCmd = SW_HIDE Then
                str01 = str01 & "非表示" & vbCrLf
            Else
                str01 = str01 & "不明" & vbCrLf
            End If
            str01 = str01 & _
                "通常サイズ時の座標(L,T)-(W,H)：" _
                & "(" & .RcNormalPosition.Left & "," & .RcNormalPosition.Top & ")" _
                & "-(" & .RcNormalPosition.Right & "," & .RcNormalPosition.Bottom & ")" & vbCrLf
            str01 = str01 & _
                "最大化サイズ時の座標(L,T)：" _
                & "(" & .PtMaxPosition.X & "," & .PtMaxPosition.Y & ")" & vbCrLf
            str01 = str01 & _
                "最小化サイズ時の座標(L,T)：" _
                & "(" & .PtMinPosition.X & "," & .PtMinPosition.Y & ")" & vbCrLf
        Else
            str01 = str01 & "取得エラー" & vbCrLf
        End If
    End With


    Debug.Print str01

End Function

'#############################################################################
'現在開いているウィンドウたちを左右に並べて表示する関数
    '事前に、VBEの参照設定にて
    '「Microsoft Shell Controls And Automation」に
    '照設定をしておきます。
'#############################################################################

Function Folder_Open()

    '事前に、VBEの参照設定にて
    '「Microsoft Shell Controls And Automation」に
    '照設定をしておきます。
    
    Dim objsample As Shell
    Set objsample = New Shell

    objsample.TileVertically 'Windows画面が分割表示されます。
    Set objsample = Nothing '開放します。

End Function

'#############################################################################
'現在開いているウィンドウたちを上下に並べて表示する関数
    '事前に、VBEの参照設定にて
    '「Microsoft Shell Controls And Automation」に
    '照設定をしておきます。
'#############################################################################

Function Folder_Open02()

    
    Dim objsample01 As Shell
    Set objsample01 = New Shell

    objsample01.TileHorizontally  'Windows画面が分割表示されます。
    Set objsample01 = Nothing '開放します。

End Function


'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425

426

427

428

429

430

431

432

433

434

435

436

437

438

439

440

441

442

443

444

445

446

447

448

449

450

451

452

453

454

455

456

457

458

459

460

461

462

463

464

465

466

467

468

469

470

471

472

473

474

475

476

477

478

479

480

481

482

483

484

485

486

487

488

489

490

491

Option Explicit

'●Win64API　ウィンドウの最大化、最小化、等、状態の取得用の定義

Public Const SW_HIDE = 0

Public Const SW_SHOWMAXIMIZED = 3

Public Const SW_SHOWMINIMIZED = 2

Public Const SW_SHOWNORMAL = 1

'Type RECT

' Left As Long

' Top As Long

' Right As Long

' Bottom As Long

'End Type

'Type POINTAPI

' X As Long

' Y As Long

'End Type

'Type WINDOWPLACEMENT

' Length As Long

' Flags As Long

' ShowCmd As Long

' PtMinPosition As POINTAPI

' PtMaxPosition As POINTAPI

' RcNormalPosition As RECT

'End Type

Public Const WPF_RESTORETOMAXIMIZED = &H2

Public Const WPF_SETMINPOSITION = &H1

'Declare Function GetWindowPlacement Lib "user32" (ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long

'●Win64API　ウィンドの大きさ変更用の定義

Public Declare PtrSafe Function GetForegroundWindow _

Lib "user32" () As Long

Public Type POINTAPI

X As Long

Y As Long

End Type

Public Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Public Type WINDOWPLACEMENT

Length As Long

Flags As Long

ShowCmd As Long

PtMinPosition As POINTAPI

PtMaxPosition As POINTAPI

RcNormalPosition As RECT

End Type

Public Declare PtrSafe Function GetWindowPlacement Lib "user32" (ByVal hwnd As LongPtr, lpwndpl As WINDOWPLACEMENT) As Long

Public Declare PtrSafe Function SetWindowPlacement Lib "user32" (ByVal hwnd As LongPtr, lpwndpl As WINDOWPLACEMENT) As Long

'●Win64API　ウィンドウの最前面表示用の定義

Declare PtrSafe Function FindWindow% Lib "user32" Alias "FindWindowA" _

(ByVal lpClassName As Any, _

ByVal lpCaption As Any)

'■「名前が適切ではありません」のエラーが出るので、コメントアウト。

'　　　（どことかぶってるかは未チェックです。多分、１つ目のモジュールの

' 64bitの分岐の「Declare PtrSafe Function FindWindow」。）

' Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _

' (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, _

ByVal hWndInsertAfter As LongPtr, _

ByVal X As Long, _

ByVal Y As Long, _

ByVal cx As Long, _

ByVal cy As Long, _

ByVal wFlags As Long) As Long

Global Const HWND_TOPMOST = -1 ' 最全面に表示する

Global Const HWND_NOTOPMOST = -2 ' 最前面に表示するのをやめる

Global Const SWP_NOSIZE = &H1 ' サイズを変更しない

Global Const SWP_NOMOVE = &H2 ' 位置を変更しない

'##########　　Win64APIの呼び出しはここまで　　################################################

'##########　　以下、Win64APIを呼び出すための関数（Win64APIを利用するための関数）　　################################################

'######################################################################################

'他のmdbのウィンドウを最前面にする関数

'win_hwnd には、「objAccess.hWndAccessApp」などで取得したウィンドウハンドルの値（Long型）を渡す

'hwndは Handle Of Window の略

'######################################################################################

Function window_most_top_on(win_hwnd As Long)

Call SetWindowPos(win_hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

End Function

'######################################################################################

'他のmdbのウィンドウの最前面を解除する関数

'win_hwnd には、「objAccess.hWndAccessApp」などで取得したウィンドウハンドルの値（Long型）を渡す

''hwndは Handle Of Window の略

'######################################################################################

Function window_most_top_off(win_hwnd As Long)

Call SetWindowPos(win_hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

End Function

'#################################################################

'自mdbを最前面に強制表示。

'#################################################################

Sub MeMdbSaiZenmenOn()

Dim objAccess As Access.Application

Set objAccess = CurrentProject.Application

Call window_most_top_on(objAccess.hWndAccessApp)

End Sub

'#################################################################

'自mdbの最前面を強制表示解除。

'#################################################################

Sub MeMdbSaiZenmenOFF()

Dim objAccess As Access.Application

Set objAccess = CurrentProject.Application

Call window_most_top_off(objAccess.hWndAccessApp)

End Sub

'######################################################################################

'●上記関数の呼び出しの使用例のコード

Sub testtest()

Dim objAccess As Access.Application

Set objAccess = CurrentProject.Application

Call window_most_top_off(objAccess.hWndAccessApp)

End Sub

'######################################################################################

'●(02)自mdbを最前面にする使用例のコード

Sub test101()

Dim objAccess As Access.Application

Set objAccess = CurrentProject.Application

Call SetWindowPos(objAccess.hWndAccessApp, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

Set objAccess = Nothing

End Sub

'●(03)自mdbの最前面を解除する使用例のコード

Sub test102()

Dim objAccess As Access.Application

Set objAccess = CurrentProject.Application

Call SetWindowPos(objAccess.hWndAccessApp, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

Set objAccess = Nothing

End Sub

'###################################################################

'開いた何らかのアプリケーションをリサイズする関数

'タイトル名からリサイズする。

'タイトル名は全部じゃなくても一部でもOKみたいです。

'###################################################################

Function app_window_risize_for_title_name(active_title_name As String, _

left_position As Integer, _

Top_position As Integer, _

Width_length As Integer, _

Height_length As Integer)

Dim myHwnd As LongPtr

Dim myWindowPlacement As WINDOWPLACEMENT

'対象をアクティブにする。アクティブにしないと動かない。

' AppActivate active_title_name

' AppActivate "TeraPad"

'ウィンドウハンドルの取得

myHwnd = GetForegroundWindow()

Debug.Print "myHwnd01---" & myHwnd '★★★★★★★★★★★★★★★

'ウィンドウ情報の取得

GetWindowPlacement myHwnd, myWindowPlacement

'ウィンドウ情報を変更して設定

With myWindowPlacement.RcNormalPosition

.Left = left_position

.Top = Top_position

.Right = Width_length + left_position

.Bottom = Height_length + Top_position

End With

Debug.Print "myHwnd02---" & myHwnd

SetWindowPlacement myHwnd, myWindowPlacement

End Function

'###################################################################

'開いた何らかのアプリケーションをリサイズする関数。

'タスクID(プロセスID）からリサイズする。

'###################################################################

Function app_window_risize_for_p_id(p_id As Integer, _

left_position As Integer, _

Top_position As Integer, _

Width_length As Integer, _

Height_length As Integer)

Dim myHwnd As LongPtr

Dim myWindowPlacement As WINDOWPLACEMENT

'対象をアクティブにする。アクティブにしないと動かない。

AppActivate p_id

'ウィンドウハンドルの取得

myHwnd = GetForegroundWindow()

'ウィンドウ情報の取得

GetWindowPlacement myHwnd, myWindowPlacement

'ウィンドウ情報を変更して設定

With myWindowPlacement.RcNormalPosition

.Left = left_position

.Top = Top_position

.Right = Width_length + left_position

.Bottom = Height_length + Top_position

End With

SetWindowPlacement myHwnd, myWindowPlacement

End Function

'###################################################################

'単純に自mdbのみをリサイズする関数。

'###################################################################

Function app_window_risize01(left_position As Integer, _

Top_position As Integer, _

Width_length As Integer, _

Height_length As Integer)

Dim myHwnd As Long

Dim myWindowPlacement As WINDOWPLACEMENT

' '対象をアクティブにする。アクティブにしないと動かない。

' AppActivate p_id ’←エラーになるのでコメントアウト。

'ウィンドウハンドルの取得

myHwnd = GetForegroundWindow()

'ウィンドウ情報の取得

GetWindowPlacement myHwnd, myWindowPlacement

'ウィンドウ情報を変更して設定

With myWindowPlacement.RcNormalPosition

.Left = left_position

.Top = Top_position

.Right = Width_length + left_position

.Bottom = Height_length + Top_position

End With

SetWindowPlacement myHwnd, myWindowPlacement

End Function

Function app_window_risize02(l_GetForegroundWindowNumber, _

left_position As Integer, _

Top_position As Integer, _

Width_length As Integer, _

Height_length As Integer)

Dim myHwnd As Long

Dim myWindowPlacement As WINDOWPLACEMENT

' '対象をアクティブにする。アクティブにしないと動かない。

' AppActivate p_id

'ウィンドウハンドルの取得

' myHwnd = GetForegroundWindow()

myHwnd = l_GetForegroundWindowNumber

'ウィンドウ情報の取得

GetWindowPlacement myHwnd, myWindowPlacement

'ウィンドウ情報を変更して設定

With myWindowPlacement.RcNormalPosition

.Left = left_position

.Top = Top_position

.Right = Width_length + left_position

.Bottom = Height_length + Top_position

End With

SetWindowPlacement myHwnd, myWindowPlacement

End Function

'###################################################################

'開いているmdb内のフォームをリサイズする関数

'上記関数を変形しただけ。

'フォーム名をモトにリサイズする。

'###################################################################

Function form_api_risize(active_form_name As String, _

left_position As Integer, _

Top_position As Integer, _

Width_length As Integer, _

Height_length As Integer)

Dim myHwnd As Long

Dim myWindowPlacement As WINDOWPLACEMENT

'フォームのウィンドウハンドルの取得

myHwnd = Forms(active_form_name).hwnd

'ウィンドウ情報の取得

GetWindowPlacement myHwnd, myWindowPlacement

'ウィンドウ情報を変更して設定

With myWindowPlacement.RcNormalPosition

.Left = left_position

.Top = Top_position

.Right = Width_length + left_position

.Bottom = Height_length + Top_position

End With

SetWindowPlacement myHwnd, myWindowPlacement

End Function

'################################################################################

'フォームの状態を調べる関数（最大化、最小化、通常、非表示）

'hWnd01 はウィンドウハンドルを指定する。Me.Hwnd など。

'################################################################################

Function frm_size_State01(hWnd01 As Long) As String

Dim lRet As Long

Dim lpWnd As WINDOWPLACEMENT

Dim str01 As String

With lpWnd

.Length = LenB(lpWnd)

lRet = GetWindowPlacement(hWnd01, lpWnd)

'str01 = "フォームの表示状態："

If lRet <> 0 Then

If .ShowCmd = SW_SHOWMINIMIZED Then

' str01 = str01 & "最小化サイズ" & vbCrLf

frm_size_State01 = "最小"

ElseIf .ShowCmd = SW_SHOWMAXIMIZED Then

' str01 = str01 & "最大化サイズ" & vbCrLf

frm_size_State01 = "最大"

ElseIf .ShowCmd = SW_SHOWNORMAL Then

' str01 = str01 & "通常サイズ" & vbCrLf

frm_size_State01 = "通常"

ElseIf .ShowCmd = SW_HIDE Then

' str01 = str01 & "非表示" & vbCrLf

frm_size_State01 = "非表示"

Else

' str01 = str01 & "不明" & vbCrLf

frm_size_State01 = "不明"

End If

Else

' str01 = str01 & "取得エラー" & vbCrLf

frm_size_State01 = "取得エラー"

End If

End With

End Function

'###################################################################

'上のコードの土台

'###################################################################

Function frm_size_State01_test(hWnd01 As Long)

Dim lRet As Long

Dim lpWnd As WINDOWPLACEMENT

Dim str01 As String

With lpWnd

.Length = LenB(lpWnd)

lRet = GetWindowPlacement(hWnd01, lpWnd)

str01 = "フォームの表示状態："

If lRet <> 0 Then

If .ShowCmd = SW_SHOWMINIMIZED Then

str01 = str01 & "最小化サイズ" & vbCrLf

ElseIf .ShowCmd = SW_SHOWMAXIMIZED Then

str01 = str01 & "最大化サイズ" & vbCrLf

ElseIf .ShowCmd = SW_SHOWNORMAL Then

str01 = str01 & "通常サイズ" & vbCrLf

ElseIf .ShowCmd = SW_HIDE Then

str01 = str01 & "非表示" & vbCrLf

Else

str01 = str01 & "不明" & vbCrLf

End If

str01 = str01 & _

"通常サイズ時の座標(L,T)-(W,H)：" _

& "(" & .RcNormalPosition.Left & "," & .RcNormalPosition.Top & ")" _

& "-(" & .RcNormalPosition.Right & "," & .RcNormalPosition.Bottom & ")" & vbCrLf

str01 = str01 & _

"最大化サイズ時の座標(L,T)：" _

& "(" & .PtMaxPosition.X & "," & .PtMaxPosition.Y & ")" & vbCrLf

str01 = str01 & _

"最小化サイズ時の座標(L,T)：" _

& "(" & .PtMinPosition.X & "," & .PtMinPosition.Y & ")" & vbCrLf

Else

str01 = str01 & "取得エラー" & vbCrLf

End If

End With

Debug.Print str01

End Function

'#############################################################################

'現在開いているウィンドウたちを左右に並べて表示する関数

'事前に、VBEの参照設定にて

'「Microsoft Shell Controls And Automation」に

'照設定をしておきます。

'#############################################################################

Function Folder_Open()

'事前に、VBEの参照設定にて

'「Microsoft Shell Controls And Automation」に

'照設定をしておきます。

Dim objsample As Shell

Set objsample = New Shell

objsample.TileVertically 'Windows画面が分割表示されます。

Set objsample = Nothing '開放します。

End Function

'#############################################################################

'現在開いているウィンドウたちを上下に並べて表示する関数

'事前に、VBEの参照設定にて

'「Microsoft Shell Controls And Automation」に

'照設定をしておきます。

'#############################################################################

Function Folder_Open02()

Dim objsample01 As Shell

Set objsample01 = New Shell

objsample01.TileHorizontally 'Windows画面が分割表示されます。

Set objsample01 = Nothing '開放します。

End Function

#####################################################################################

★ 32bit用 Only の２つのモジュール

'
'
Option Explicit

'Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
'↑「Sleep」関数で、ミリ秒、待つためのAPIコード。


#If Win64 Then
 '【GetNextWindow関数】
    Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" _
    (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
 
 '【IsWindowVisible関数】
    Declare PtrSafe Function IsWindowVisible Lib "user32" _
    (ByVal hwnd As LongPtr) As LongPtr
 
 '【GetWindowText関数】
    Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As LongPtr
 
 '【FindWindow関数】
    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
 
    Dim hwnd As LongPtr
    
#Else
 '【GetNextWindow関数】
    Declare Function GetNextWindow Lib "user32" Alias "GetWindow" _
    (ByVal hwnd As Long, ByVal wFlag As Long) As Long
 
 '【IsWindowVisible関数】
    Declare Function IsWindowVisible Lib "user32" _
    (ByVal hwnd As Long) As Long
 
 '【GetWindowText関数】
    Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
 
 '【FindWindow関数】
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
    Dim hwnd As Long
 
#End If
 
Const GW_HWNDLAST = 1
Const GW_HWNDNEXT = 2

'-------------------------------------------------------------------------------------
'APIのWebページ付属のサンプルプログラム
'今回は、これを無理矢理に関数化しました。
'-------------------------------------------------------------------------------------
Sub main()
 
   
    Dim strCaption As String * 500
    
    hwnd = FindWindow(vbNullString, vbNullString)
    
    Dim caps As Collection
    Set caps = New Collection
    Dim cap 'As String
    Do
        If IsWindowVisible(hwnd) Then
        
            GetWindowText hwnd, strCaption, Len(strCaption)
            
            cap = Left(strCaption, InStr(strCaption, vbNullChar) - 1)
            If cap <> "" Then
                caps.Add cap
            End If
            
        End If
    
        hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)
    
    Loop Until hwnd = GetNextWindow(hwnd, GW_HWNDLAST)
    
    For Each cap In caps
        Debug.Print cap
    Next cap
 
End Sub


'###################################################################################
'ファイルの起動＋関数の呼び出し事例プログラム
'###################################################################################

Function FileBoot01(s_FilePath01 As String)

    Dim s_WindowTitle As String
    
    
    'ファイルを起動。
    With CreateObject("Shell.Application")
        .ShellExecute s_FilePath01
    End With
    
    
    
'    ' 起動を待つ  ’旧バージョンン。ダメだった。使えない。
'    Do Until objShell.AppActivate(objExec.ProcessID)
'        Sleep 1000
'        DoEvents
'        Debug.Print objExec.ProcessID
'        Debug.Print objShell.AppActivate(objExec.ProcessID)
'    Loop


    s_WindowTitle = WindowTitleGet01(Dir(s_FilePath01))
    '↑ウィンドウタイトルを取得。
    '　この「WindowTitleGet01」関数である程度、起動を「待つ」。
    
    Debug.Print s_WindowTitle & "-----★本番データ"
    
    Sleep 500     '（API）
    '↑さらに少し待つと、確実？なのか？
    '　とりあえず２秒も、３秒も待たなくて良い・・・、っぽい。
    
'    Let s_WindowTitle = "JUST PDF [編集] - [1.pdf]"
    
    AppActivate s_WindowTitle
    '↑ 目的のウィンドウタイトルのウィンドウをアクティブにする
    '　本当に効いているのかは少々疑問。
    '　　→コメントアウトしてテストしたら動かなかったので、結果、効いていたことになる。
    '　ただ、もしかしたら、場合によってはこのコード無くてもOKなケースもあるかもしれない。（未調査）
    
    
'    Debug.Print WindowTitleGet01(Dir(s_FilePath01)) & "---(A)"
    
    
    
'    Call app_window_risize01(0, 10, 300, 650)
    Call app_window_risize01(501, 10, 780, 650)
    '↑目的のウィンドウのリサイズ。
    
    
'    AppActivate WindowTitleGet01("ドラッグ")
'    Debug.Print WindowTitleGet01("ドラッグ")
'    '↑とりあえずのテストをしただけ。コメントアウト。

    
End Function

'###################################################################################
'ファイルの起動＋関数の呼び出し事例プログラム
'###################################################################################


Function WindowTitleGet01(s_ChkWord01 As String) As String

    Dim strCaption As String * 500
    '長さ500の文字列型変数の宣言
    
    Do
   
        strCaption = ""
        
        hwnd = FindWindow(vbNullString, vbNullString)
        
        
        '↓コレクションの生成
        Dim caps As Collection
        Dim cap 'As String
        Set caps = New Collection
        Do
            If IsWindowVisible(hwnd) Then
            
                GetWindowText hwnd, strCaption, Len(strCaption)
                
                cap = Left(strCaption, InStr(strCaption, vbNullChar) - 1)
                If cap <> "" Then
                    caps.Add cap
                End If
                
            End If
        
            hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)
        
        Loop Until hwnd = GetNextWindow(hwnd, GW_HWNDLAST)
        '↑コレクションの生成
        
        
        
        For Each cap In caps
        
'            Debug.Print cap & "---WTG-Function"
            
            If 1 <= InStr(1, cap, s_ChkWord01, vbBinaryCompare) Then
                WindowTitleGet01 = cap
                Set caps = Nothing
                Exit Function
            Else
            
            End If
        Next cap
        '↑コレクションの中に目的の検索文言を含むウィンドウタイトルがあるか調べ、
        '　あったらユーザーにそれを返してプロシージャも終わる。
        
        Set caps = Nothing
        'コレクションの消滅
    
    Loop
    
End Function


'********************************************
'********************************************
'以下、２つめのモジュール。
'********************************************
'********************************************
Option Explicit

'●Win64API　ウィンドウの最大化、最小化、等、状態の取得用の定義

Public Const SW_HIDE = 0
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWNORMAL = 1

'Type RECT
'    Left As Long
'    Top As Long
'    Right As Long
'    Bottom As Long
'End Type

'Type POINTAPI
'    X As Long
'    Y As Long
'End Type

'Type WINDOWPLACEMENT
'    Length As Long
'    Flags As Long
'    ShowCmd As Long
'    PtMinPosition As POINTAPI
'    PtMaxPosition As POINTAPI
'    RcNormalPosition As RECT
'End Type

Public Const WPF_RESTORETOMAXIMIZED = &H2
Public Const WPF_SETMINPOSITION = &H1

'Declare Function GetWindowPlacement Lib "user32" (ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long


'●Win64API　ウィンドの大きさ変更用の定義

'Public Declare PtrSafe Function GetForegroundWindow _
'    Lib "user32" () As Long


Public Declare Function GetForegroundWindow Lib "user32" () As Long

Public Type POINTAPI
    X As Long
    Y As Long
End Type

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Type WINDOWPLACEMENT
    Length As Long
    Flags As Long
    ShowCmd As Long
    PtMinPosition As POINTAPI
    PtMaxPosition As POINTAPI
    RcNormalPosition As RECT
End Type

'Public Declare PtrSafe Function GetWindowPlacement Lib "user32" (ByVal hwnd As LongPtr, lpwndpl As WINDOWPLACEMENT) As Long
'Public Declare PtrSafe Function SetWindowPlacement Lib "user32" (ByVal hwnd As LongPtr, lpwndpl As WINDOWPLACEMENT) As Long
'
Public Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Public Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long



'●Win64API　ウィンドウの最前面表示用の定義
                                          
' Declare PtrSafe Function FindWindow% Lib "user32" Alias "FindWindowA" _
'                                          (ByVal lpClassName As Any, _
'                                           ByVal lpCaption As Any)

 Declare Function FindWindow% Lib "user32" Alias "FindWindowA" _
                                          (ByVal lpClassName As Any, _
                                           ByVal lpCaption As Any)


'  Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
'  (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
'
'
' Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, _
'                                 ByVal hWndInsertAfter As LongPtr, _
'                                 ByVal X As Long, _
'                                 ByVal Y As Long, _
'                                 ByVal cx As Long, _
'                                 ByVal cy As Long, _
'                                 ByVal wFlags As Long) As Long


'■■■32bit修正個所　エラー出るか？→出る。32bitでは永遠にコメントアウト
'    Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
’    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

 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 wFlags As Long) As Long


Global Const HWND_TOPMOST = -1   ' 最全面に表示する
Global Const HWND_NOTOPMOST = -2 ' 最前面に表示するのをやめる
Global Const SWP_NOSIZE = &H1    ' サイズを変更しない
Global Const SWP_NOMOVE = &H2    ' 位置を変更しない



'##########　　Win32APIの呼び出しはここまで　　################################################

'##########　　以下、Win32APIを呼び出すための関数（Win32APIを利用するための関数）　　################################################




'######################################################################################
'他のmdbのウィンドウを最前面にする関数
'win_hwnd には、「objAccess.hWndAccessApp」などで取得したウィンドウハンドルの値（Long型）を渡す
'hwndは Handle Of Window の略
'######################################################################################

Function window_most_top_on(win_hwnd As Long)

   Call SetWindowPos(win_hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

End Function

'######################################################################################
'他のmdbのウィンドウの最前面を解除する関数
'win_hwnd には、「objAccess.hWndAccessApp」などで取得したウィンドウハンドルの値（Long型）を渡す
''hwndは Handle Of Window の略
'######################################################################################


Function window_most_top_off(win_hwnd As Long)

   Call SetWindowPos(win_hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

End Function


'#################################################################
'自mdbを最前面に強制表示。
'#################################################################
Sub MeMdbSaiZenmenOn()
   Dim objAccess As Access.Application
   Set objAccess = CurrentProject.Application
   Call window_most_top_on(objAccess.hWndAccessApp)
End Sub

'#################################################################
'自mdbの最前面を強制表示解除。
'#################################################################
Sub MeMdbSaiZenmenOFF()
   Dim objAccess As Access.Application
   Set objAccess = CurrentProject.Application
   Call window_most_top_off(objAccess.hWndAccessApp)
End Sub


'######################################################################################

'●上記関数の呼び出しの使用例のコード
Sub testtest()
   Dim objAccess As Access.Application
   Set objAccess = CurrentProject.Application
   Call window_most_top_off(objAccess.hWndAccessApp)
End Sub

'######################################################################################

'●(02)自mdbを最前面にする使用例のコード
Sub test101()

   Dim objAccess As Access.Application
   Set objAccess = CurrentProject.Application
   Call SetWindowPos(objAccess.hWndAccessApp, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
   Set objAccess = Nothing
End Sub



'●(03)自mdbの最前面を解除する使用例のコード

Sub test102()
   Dim objAccess As Access.Application
   Set objAccess = CurrentProject.Application
   Call SetWindowPos(objAccess.hWndAccessApp, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
   Set objAccess = Nothing
End Sub


'###################################################################
'開いた何らかのアプリケーションをリサイズする関数
'タイトル名からリサイズする。
'タイトル名は全部じゃなくても一部でもOKみたいです。
'###################################################################

Function app_window_risize_for_title_name(active_title_name As String, _
                                          left_position As Integer, _
                                          Top_position As Integer, _
                                          Width_length As Integer, _
                                          Height_length As Integer)

'    Dim myHwnd As LongPtr  '★★★★★★
    Dim myHwnd As Long
    Dim myWindowPlacement As WINDOWPLACEMENT


    '対象をアクティブにする。アクティブにしないと動かない。
'    AppActivate active_title_name
'    AppActivate "TeraPad"
    
    'ウィンドウハンドルの取得
    myHwnd = GetForegroundWindow()
    Debug.Print "myHwnd01---" & myHwnd   '★★★★★★★★★★★★★★★
    
    'ウィンドウ情報の取得
    GetWindowPlacement myHwnd, myWindowPlacement
    'ウィンドウ情報を変更して設定
    With myWindowPlacement.RcNormalPosition
        .Left = left_position
        .Top = Top_position
        .Right = Width_length + left_position
        .Bottom = Height_length + Top_position
    End With
    
    Debug.Print "myHwnd02---" & myHwnd
    SetWindowPlacement myHwnd, myWindowPlacement

End Function



'###################################################################
'開いた何らかのアプリケーションをリサイズする関数。
'タスクID(プロセスID）からリサイズする。
'
'###################################################################

Function app_window_risize_for_p_id(p_id As Integer, _
                                    left_position As Integer, _
                                    Top_position As Integer, _
                                    Width_length As Integer, _
                                    Height_length As Integer)

'    Dim myHwnd As LongPtr   '★★★★★★
    Dim myHwnd As Long
    Dim myWindowPlacement As WINDOWPLACEMENT


    '対象をアクティブにする。アクティブにしないと動かない。
    AppActivate p_id

    'ウィンドウハンドルの取得
    myHwnd = GetForegroundWindow()
    'ウィンドウ情報の取得
    GetWindowPlacement myHwnd, myWindowPlacement
    'ウィンドウ情報を変更して設定
    With myWindowPlacement.RcNormalPosition
        .Left = left_position
        .Top = Top_position
        .Right = Width_length + left_position
        .Bottom = Height_length + Top_position
    End With
    SetWindowPlacement myHwnd, myWindowPlacement

End Function



'###################################################################
'単純に自mdbのみをリサイズする関数。
'
'
'###################################################################

Function app_window_risize01(left_position As Integer, _
                                    Top_position As Integer, _
                                    Width_length As Integer, _
                                    Height_length As Integer)

    Dim myHwnd As Long
    Dim myWindowPlacement As WINDOWPLACEMENT

'
'    '対象をアクティブにする。アクティブにしないと動かない。
'    AppActivate p_id  ’←エラーになるのでコメントアウト。

    'ウィンドウハンドルの取得
    myHwnd = GetForegroundWindow()
    'ウィンドウ情報の取得
    GetWindowPlacement myHwnd, myWindowPlacement
    'ウィンドウ情報を変更して設定
    With myWindowPlacement.RcNormalPosition
        .Left = left_position
        .Top = Top_position
        .Right = Width_length + left_position
        .Bottom = Height_length + Top_position
    End With
    SetWindowPlacement myHwnd, myWindowPlacement

End Function



Function app_window_risize02(l_GetForegroundWindowNumber, _
                                    left_position As Integer, _
                                    Top_position As Integer, _
                                    Width_length As Integer, _
                                    Height_length As Integer)

    Dim myHwnd As Long
    Dim myWindowPlacement As WINDOWPLACEMENT

'
'    '対象をアクティブにする。アクティブにしないと動かない。
'    AppActivate p_id

    'ウィンドウハンドルの取得
'    myHwnd = GetForegroundWindow()
    myHwnd = l_GetForegroundWindowNumber
    'ウィンドウ情報の取得
    GetWindowPlacement myHwnd, myWindowPlacement
    'ウィンドウ情報を変更して設定
    With myWindowPlacement.RcNormalPosition
        .Left = left_position
        .Top = Top_position
        .Right = Width_length + left_position
        .Bottom = Height_length + Top_position
    End With
    SetWindowPlacement myHwnd, myWindowPlacement

End Function


'###################################################################
'開いているmdb内のフォームをリサイズする関数
'上記関数を変形しただけ。
'フォーム名をモトにリサイズする。
'
'###################################################################

Function form_api_risize(active_form_name As String, _
                         left_position As Integer, _
                         Top_position As Integer, _
                         Width_length As Integer, _
                         Height_length As Integer)

    Dim myHwnd As Long
    Dim myWindowPlacement As WINDOWPLACEMENT



    'フォームのウィンドウハンドルの取得
     myHwnd = Forms(active_form_name).hwnd

    'ウィンドウ情報の取得
    GetWindowPlacement myHwnd, myWindowPlacement

    'ウィンドウ情報を変更して設定
    With myWindowPlacement.RcNormalPosition
        .Left = left_position
        .Top = Top_position
        .Right = Width_length + left_position
        .Bottom = Height_length + Top_position
    End With
    SetWindowPlacement myHwnd, myWindowPlacement

End Function

'################################################################################
'フォームの状態を調べる関数（最大化、最小化、通常、非表示）
'hWnd01 はウィンドウハンドルを指定する。Me.Hwnd など。
'
'################################################################################

Function frm_size_State01(hWnd01 As Long) As String

    Dim lRet As Long
    Dim lpWnd As WINDOWPLACEMENT
    Dim str01 As String

    With lpWnd
        .Length = LenB(lpWnd)
        lRet = GetWindowPlacement(hWnd01, lpWnd)

        'str01 = "フォームの表示状態："
        If lRet <> 0 Then
            If .ShowCmd = SW_SHOWMINIMIZED Then
'                str01 = str01 & "最小化サイズ" & vbCrLf
                frm_size_State01 = "最小"
            ElseIf .ShowCmd = SW_SHOWMAXIMIZED Then
'                str01 = str01 & "最大化サイズ" & vbCrLf
                frm_size_State01 = "最大"
            ElseIf .ShowCmd = SW_SHOWNORMAL Then
'                str01 = str01 & "通常サイズ" & vbCrLf
                frm_size_State01 = "通常"
            ElseIf .ShowCmd = SW_HIDE Then
'                str01 = str01 & "非表示" & vbCrLf
                frm_size_State01 = "非表示"
            Else
'                str01 = str01 & "不明" & vbCrLf
                frm_size_State01 = "不明"
            End If

        Else
'            str01 = str01 & "取得エラー" & vbCrLf
                frm_size_State01 = "取得エラー"
        End If
    End With

End Function

'###################################################################
'上のコードの土台
'###################################################################

Function frm_size_State01_test(hWnd01 As Long)

    Dim lRet As Long
    Dim lpWnd As WINDOWPLACEMENT
    Dim str01 As String

    With lpWnd
        .Length = LenB(lpWnd)
        lRet = GetWindowPlacement(hWnd01, lpWnd)

        str01 = "フォームの表示状態："
        If lRet <> 0 Then
            If .ShowCmd = SW_SHOWMINIMIZED Then
                str01 = str01 & "最小化サイズ" & vbCrLf
            ElseIf .ShowCmd = SW_SHOWMAXIMIZED Then
                str01 = str01 & "最大化サイズ" & vbCrLf
            ElseIf .ShowCmd = SW_SHOWNORMAL Then
                str01 = str01 & "通常サイズ" & vbCrLf
            ElseIf .ShowCmd = SW_HIDE Then
                str01 = str01 & "非表示" & vbCrLf
            Else
                str01 = str01 & "不明" & vbCrLf
            End If
            str01 = str01 & _
                "通常サイズ時の座標(L,T)-(W,H)：" _
                & "(" & .RcNormalPosition.Left & "," & .RcNormalPosition.Top & ")" _
                & "-(" & .RcNormalPosition.Right & "," & .RcNormalPosition.Bottom & ")" & vbCrLf
            str01 = str01 & _
                "最大化サイズ時の座標(L,T)：" _
                & "(" & .PtMaxPosition.X & "," & .PtMaxPosition.Y & ")" & vbCrLf
            str01 = str01 & _
                "最小化サイズ時の座標(L,T)：" _
                & "(" & .PtMinPosition.X & "," & .PtMinPosition.Y & ")" & vbCrLf
        Else
            str01 = str01 & "取得エラー" & vbCrLf
        End If
    End With


    Debug.Print str01

End Function

'#############################################################################
'現在開いているウィンドウたちを左右に並べて表示する関数
    '事前に、VBEの参照設定にて
    '「Microsoft Shell Controls And Automation」に
    '照設定をしておきます。
'#############################################################################

Function Folder_Open()

    '事前に、VBEの参照設定にて
    '「Microsoft Shell Controls And Automation」に
    '照設定をしておきます。
    
    Dim objsample As Shell
    Set objsample = New Shell

    objsample.TileVertically 'Windows画面が分割表示されます。
    Set objsample = Nothing '開放します。

End Function

'#############################################################################
'現在開いているウィンドウたちを上下に並べて表示する関数
    '事前に、VBEの参照設定にて
    '「Microsoft Shell Controls And Automation」に
    '照設定をしておきます。
'#############################################################################

Function Folder_Open02()

    
    Dim objsample01 As Shell
    Set objsample01 = New Shell

    objsample01.TileHorizontally  'Windows画面が分割表示されます。
    Set objsample01 = Nothing '開放します。

End Function


'
'


'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425

426

427

428

429

430

431

432

433

434

435

436

437

438

439

440

441

442

443

444

445

446

447

448

449

450

451

452

453

454

455

456

457

458

459

460

461

462

463

464

465

466

467

468

469

470

471

472

473

474

475

476

477

478

479

480

481

482

483

484

485

486

487

488

489

490

491

492

493

494

495

496

497

498

499

500

501

502

503

504

505

506

507

508

509

510

511

512

513

514

515

516

517

518

519

520

521

522

523

524

525

526

527

528

529

530

531

532

533

534

535

536

537

538

539

540

541

542

543

544

545

546

547

548

549

550

551

552

553

554

555

556

557

558

559

560

561

562

563

564

565

566

567

568

569

570

571

572

573

574

575

576

577

578

579

580

581

582

583

584

585

586

587

588

589

590

591

592

593

594

595

596

597

598

599

600

601

602

603

604

605

606

607

608

609

610

611

612

613

614

615

616

617

618

619

620

621

622

623

624

625

626

627

628

629

630

631

632

633

634

635

636

637

638

639

640

641

642

643

644

645

646

647

648

649

650

651

652

653

654

655

656

657

658

659

660

661

662

663

664

665

666

667

668

669

670

671

672

673

674

675

676

677

678

679

680

681

682

683

684

685

686

687

688

689

690

691

692

693

694

695

696

697

698

699

700

701

702

703

704

705

706

707

708

709

710

711

712

713

714

715

716

717

718

719

720

721

722

723

724

725

726

727

728

729

730

731

732

733

Option Explicit

'Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

'↑「Sleep」関数で、ミリ秒、待つためのAPIコード。

#If Win64 Then

'【GetNextWindow関数】

Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" _

(ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr

'【IsWindowVisible関数】

Declare PtrSafe Function IsWindowVisible Lib "user32" _

(ByVal hwnd As LongPtr) As LongPtr

'【GetWindowText関数】

Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _

(ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As LongPtr

'【FindWindow関数】

Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _

(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Dim hwnd As LongPtr

#Else

'【GetNextWindow関数】

Declare Function GetNextWindow Lib "user32" Alias "GetWindow" _

(ByVal hwnd As Long, ByVal wFlag As Long) As Long

'【IsWindowVisible関数】

Declare Function IsWindowVisible Lib "user32" _

(ByVal hwnd As Long) As Long

'【GetWindowText関数】

Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _

(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

'【FindWindow関数】

Declare Function FindWindow Lib "user32" Alias "FindWindowA" _

(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Dim hwnd As Long

#End If

Const GW_HWNDLAST = 1

Const GW_HWNDNEXT = 2

'-------------------------------------------------------------------------------------

'APIのWebページ付属のサンプルプログラム

'今回は、これを無理矢理に関数化しました。

'-------------------------------------------------------------------------------------

Sub main()

Dim strCaption As String * 500

hwnd = FindWindow(vbNullString, vbNullString)

Dim caps As Collection

Set caps = New Collection

Dim cap 'As String

If IsWindowVisible(hwnd) Then

GetWindowText hwnd, strCaption, Len(strCaption)

cap = Left(strCaption, InStr(strCaption, vbNullChar) - 1)

If cap <> "" Then

caps.Add cap

End If

hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)

Loop Until hwnd = GetNextWindow(hwnd, GW_HWNDLAST)

For Each cap In caps

Debug.Print cap

Next cap

End Sub

'###################################################################################

'ファイルの起動＋関数の呼び出し事例プログラム

'###################################################################################

Function FileBoot01(s_FilePath01 As String)

Dim s_WindowTitle As String

'ファイルを起動。

With CreateObject("Shell.Application")

.ShellExecute s_FilePath01

End With

' ' 起動を待つ ’旧バージョンン。ダメだった。使えない。

' Do Until objShell.AppActivate(objExec.ProcessID)

' Sleep 1000

' DoEvents

' Debug.Print objExec.ProcessID

' Debug.Print objShell.AppActivate(objExec.ProcessID)

' Loop

s_WindowTitle = WindowTitleGet01(Dir(s_FilePath01))

'↑ウィンドウタイトルを取得。

'　この「WindowTitleGet01」関数である程度、起動を「待つ」。

Debug.Print s_WindowTitle & "-----★本番データ"

Sleep 500 '（API）

'↑さらに少し待つと、確実？なのか？

'　とりあえず２秒も、３秒も待たなくて良い・・・、っぽい。

' Let s_WindowTitle = "JUST PDF [編集] - [1.pdf]"

AppActivate s_WindowTitle

'↑ 目的のウィンドウタイトルのウィンドウをアクティブにする

'　本当に効いているのかは少々疑問。

'　　→コメントアウトしてテストしたら動かなかったので、結果、効いていたことになる。

'　ただ、もしかしたら、場合によってはこのコード無くてもOKなケースもあるかもしれない。（未調査）

' Debug.Print WindowTitleGet01(Dir(s_FilePath01)) & "---(A)"

' Call app_window_risize01(0, 10, 300, 650)

Call app_window_risize01(501, 10, 780, 650)

'↑目的のウィンドウのリサイズ。

' AppActivate WindowTitleGet01("ドラッグ")

' Debug.Print WindowTitleGet01("ドラッグ")

' '↑とりあえずのテストをしただけ。コメントアウト。

End Function

'###################################################################################

'ファイルの起動＋関数の呼び出し事例プログラム

'###################################################################################

Function WindowTitleGet01(s_ChkWord01 As String) As String

Dim strCaption As String * 500

'長さ500の文字列型変数の宣言

strCaption = ""

hwnd = FindWindow(vbNullString, vbNullString)

'↓コレクションの生成

Dim caps As Collection

Dim cap 'As String

Set caps = New Collection

If IsWindowVisible(hwnd) Then

GetWindowText hwnd, strCaption, Len(strCaption)

cap = Left(strCaption, InStr(strCaption, vbNullChar) - 1)

If cap <> "" Then

caps.Add cap

End If

hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)

Loop Until hwnd = GetNextWindow(hwnd, GW_HWNDLAST)

'↑コレクションの生成

For Each cap In caps

' Debug.Print cap & "---WTG-Function"

If 1 <= InStr(1, cap, s_ChkWord01, vbBinaryCompare) Then

WindowTitleGet01 = cap

Set caps = Nothing

Exit Function

Else

End If

Next cap

'↑コレクションの中に目的の検索文言を含むウィンドウタイトルがあるか調べ、

'　あったらユーザーにそれを返してプロシージャも終わる。

Set caps = Nothing

'コレクションの消滅

Loop

End Function

'********************************************

'以下、２つめのモジュール。

'********************************************

Option Explicit

'●Win64API　ウィンドウの最大化、最小化、等、状態の取得用の定義

Public Const SW_HIDE = 0

Public Const SW_SHOWMAXIMIZED = 3

Public Const SW_SHOWMINIMIZED = 2

Public Const SW_SHOWNORMAL = 1

'Type RECT

' Left As Long

' Top As Long

' Right As Long

' Bottom As Long

'End Type

'Type POINTAPI

' X As Long

' Y As Long

'End Type

'Type WINDOWPLACEMENT

' Length As Long

' Flags As Long

' ShowCmd As Long

' PtMinPosition As POINTAPI

' PtMaxPosition As POINTAPI

' RcNormalPosition As RECT

'End Type

Public Const WPF_RESTORETOMAXIMIZED = &H2

Public Const WPF_SETMINPOSITION = &H1

'Declare Function GetWindowPlacement Lib "user32" (ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long

'●Win64API　ウィンドの大きさ変更用の定義

'Public Declare PtrSafe Function GetForegroundWindow _

' Lib "user32" () As Long

Public Declare Function GetForegroundWindow Lib "user32" () As Long

Public Type POINTAPI

X As Long

Y As Long

End Type

Public Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Public Type WINDOWPLACEMENT

Length As Long

Flags As Long

ShowCmd As Long

PtMinPosition As POINTAPI

PtMaxPosition As POINTAPI

RcNormalPosition As RECT

End Type

'Public Declare PtrSafe Function GetWindowPlacement Lib "user32" (ByVal hwnd As LongPtr, lpwndpl As WINDOWPLACEMENT) As Long

'Public Declare PtrSafe Function SetWindowPlacement Lib "user32" (ByVal hwnd As LongPtr, lpwndpl As WINDOWPLACEMENT) As Long

Public Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long

Public Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long

'●Win64API　ウィンドウの最前面表示用の定義

' Declare PtrSafe Function FindWindow% Lib "user32" Alias "FindWindowA" _

' (ByVal lpClassName As Any, _

' ByVal lpCaption As Any)

Declare Function FindWindow% Lib "user32" Alias "FindWindowA" _

(ByVal lpClassName As Any, _

ByVal lpCaption As Any)

' Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _

' (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

' Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, _

' ByVal hWndInsertAfter As LongPtr, _

' ByVal X As Long, _

' ByVal Y As Long, _

' ByVal cx As Long, _

' ByVal cy As Long, _

' ByVal wFlags As Long) As Long

'■■■32bit修正個所　エラー出るか？→出る。32bitでは永遠にコメントアウト

' Declare Function FindWindow Lib "user32" Alias "FindWindowA" _

’ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

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 wFlags As Long) As Long

Global Const HWND_TOPMOST = -1 ' 最全面に表示する

Global Const HWND_NOTOPMOST = -2 ' 最前面に表示するのをやめる

Global Const SWP_NOSIZE = &H1 ' サイズを変更しない

Global Const SWP_NOMOVE = &H2 ' 位置を変更しない

'##########　　Win32APIの呼び出しはここまで　　################################################

'##########　　以下、Win32APIを呼び出すための関数（Win32APIを利用するための関数）　　################################################

'######################################################################################

'他のmdbのウィンドウを最前面にする関数

'win_hwnd には、「objAccess.hWndAccessApp」などで取得したウィンドウハンドルの値（Long型）を渡す

'hwndは Handle Of Window の略

'######################################################################################

Function window_most_top_on(win_hwnd As Long)

Call SetWindowPos(win_hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

End Function

'######################################################################################

'他のmdbのウィンドウの最前面を解除する関数

'win_hwnd には、「objAccess.hWndAccessApp」などで取得したウィンドウハンドルの値（Long型）を渡す

''hwndは Handle Of Window の略

'######################################################################################

Function window_most_top_off(win_hwnd As Long)

Call SetWindowPos(win_hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

End Function

'#################################################################

'自mdbを最前面に強制表示。

'#################################################################

Sub MeMdbSaiZenmenOn()

Dim objAccess As Access.Application

Set objAccess = CurrentProject.Application

Call window_most_top_on(objAccess.hWndAccessApp)

End Sub

'#################################################################

'自mdbの最前面を強制表示解除。

'#################################################################

Sub MeMdbSaiZenmenOFF()

Dim objAccess As Access.Application

Set objAccess = CurrentProject.Application

Call window_most_top_off(objAccess.hWndAccessApp)

End Sub

'######################################################################################

'●上記関数の呼び出しの使用例のコード

Sub testtest()

Dim objAccess As Access.Application

Set objAccess = CurrentProject.Application

Call window_most_top_off(objAccess.hWndAccessApp)

End Sub

'######################################################################################

'●(02)自mdbを最前面にする使用例のコード

Sub test101()

Dim objAccess As Access.Application

Set objAccess = CurrentProject.Application

Call SetWindowPos(objAccess.hWndAccessApp, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

Set objAccess = Nothing

End Sub

'●(03)自mdbの最前面を解除する使用例のコード

Sub test102()

Dim objAccess As Access.Application

Set objAccess = CurrentProject.Application

Call SetWindowPos(objAccess.hWndAccessApp, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

Set objAccess = Nothing

End Sub

'###################################################################

'開いた何らかのアプリケーションをリサイズする関数

'タイトル名からリサイズする。

'タイトル名は全部じゃなくても一部でもOKみたいです。

'###################################################################

Function app_window_risize_for_title_name(active_title_name As String, _

left_position As Integer, _

Top_position As Integer, _

Width_length As Integer, _

Height_length As Integer)

' Dim myHwnd As LongPtr '★★★★★★

Dim myHwnd As Long

Dim myWindowPlacement As WINDOWPLACEMENT

'対象をアクティブにする。アクティブにしないと動かない。

' AppActivate active_title_name

' AppActivate "TeraPad"

'ウィンドウハンドルの取得

myHwnd = GetForegroundWindow()

Debug.Print "myHwnd01---" & myHwnd '★★★★★★★★★★★★★★★

'ウィンドウ情報の取得

GetWindowPlacement myHwnd, myWindowPlacement

'ウィンドウ情報を変更して設定

With myWindowPlacement.RcNormalPosition

.Left = left_position

.Top = Top_position

.Right = Width_length + left_position

.Bottom = Height_length + Top_position

End With

Debug.Print "myHwnd02---" & myHwnd

SetWindowPlacement myHwnd, myWindowPlacement

End Function

'###################################################################

'開いた何らかのアプリケーションをリサイズする関数。

'タスクID(プロセスID）からリサイズする。

'###################################################################

Function app_window_risize_for_p_id(p_id As Integer, _

left_position As Integer, _

Top_position As Integer, _

Width_length As Integer, _

Height_length As Integer)

' Dim myHwnd As LongPtr '★★★★★★

Dim myHwnd As Long

Dim myWindowPlacement As WINDOWPLACEMENT

'対象をアクティブにする。アクティブにしないと動かない。

AppActivate p_id

'ウィンドウハンドルの取得

myHwnd = GetForegroundWindow()

'ウィンドウ情報の取得

GetWindowPlacement myHwnd, myWindowPlacement

'ウィンドウ情報を変更して設定

With myWindowPlacement.RcNormalPosition

.Left = left_position

.Top = Top_position

.Right = Width_length + left_position

.Bottom = Height_length + Top_position

End With

SetWindowPlacement myHwnd, myWindowPlacement

End Function

'###################################################################

'単純に自mdbのみをリサイズする関数。

'###################################################################

Function app_window_risize01(left_position As Integer, _

Top_position As Integer, _

Width_length As Integer, _

Height_length As Integer)

Dim myHwnd As Long

Dim myWindowPlacement As WINDOWPLACEMENT

' '対象をアクティブにする。アクティブにしないと動かない。

' AppActivate p_id ’←エラーになるのでコメントアウト。

'ウィンドウハンドルの取得

myHwnd = GetForegroundWindow()

'ウィンドウ情報の取得

GetWindowPlacement myHwnd, myWindowPlacement

'ウィンドウ情報を変更して設定

With myWindowPlacement.RcNormalPosition

.Left = left_position

.Top = Top_position

.Right = Width_length + left_position

.Bottom = Height_length + Top_position

End With

SetWindowPlacement myHwnd, myWindowPlacement

End Function

Function app_window_risize02(l_GetForegroundWindowNumber, _

left_position As Integer, _

Top_position As Integer, _

Width_length As Integer, _

Height_length As Integer)

Dim myHwnd As Long

Dim myWindowPlacement As WINDOWPLACEMENT

' '対象をアクティブにする。アクティブにしないと動かない。

' AppActivate p_id

'ウィンドウハンドルの取得

' myHwnd = GetForegroundWindow()

myHwnd = l_GetForegroundWindowNumber

'ウィンドウ情報の取得

GetWindowPlacement myHwnd, myWindowPlacement

'ウィンドウ情報を変更して設定

With myWindowPlacement.RcNormalPosition

.Left = left_position

.Top = Top_position

.Right = Width_length + left_position

.Bottom = Height_length + Top_position

End With

SetWindowPlacement myHwnd, myWindowPlacement

End Function

'###################################################################

'開いているmdb内のフォームをリサイズする関数

'上記関数を変形しただけ。

'フォーム名をモトにリサイズする。

'###################################################################

Function form_api_risize(active_form_name As String, _

left_position As Integer, _

Top_position As Integer, _

Width_length As Integer, _

Height_length As Integer)

Dim myHwnd As Long

Dim myWindowPlacement As WINDOWPLACEMENT

'フォームのウィンドウハンドルの取得

myHwnd = Forms(active_form_name).hwnd

'ウィンドウ情報の取得

GetWindowPlacement myHwnd, myWindowPlacement

'ウィンドウ情報を変更して設定

With myWindowPlacement.RcNormalPosition

.Left = left_position

.Top = Top_position

.Right = Width_length + left_position

.Bottom = Height_length + Top_position

End With

SetWindowPlacement myHwnd, myWindowPlacement

End Function

'################################################################################

'フォームの状態を調べる関数（最大化、最小化、通常、非表示）

'hWnd01 はウィンドウハンドルを指定する。Me.Hwnd など。

'################################################################################

Function frm_size_State01(hWnd01 As Long) As String

Dim lRet As Long

Dim lpWnd As WINDOWPLACEMENT

Dim str01 As String

With lpWnd

.Length = LenB(lpWnd)

lRet = GetWindowPlacement(hWnd01, lpWnd)

'str01 = "フォームの表示状態："

If lRet <> 0 Then

If .ShowCmd = SW_SHOWMINIMIZED Then

' str01 = str01 & "最小化サイズ" & vbCrLf

frm_size_State01 = "最小"

ElseIf .ShowCmd = SW_SHOWMAXIMIZED Then

' str01 = str01 & "最大化サイズ" & vbCrLf

frm_size_State01 = "最大"

ElseIf .ShowCmd = SW_SHOWNORMAL Then

' str01 = str01 & "通常サイズ" & vbCrLf

frm_size_State01 = "通常"

ElseIf .ShowCmd = SW_HIDE Then

' str01 = str01 & "非表示" & vbCrLf

frm_size_State01 = "非表示"

Else

' str01 = str01 & "不明" & vbCrLf

frm_size_State01 = "不明"

End If

Else

' str01 = str01 & "取得エラー" & vbCrLf

frm_size_State01 = "取得エラー"

End If

End With

End Function

'###################################################################

'上のコードの土台

'###################################################################

Function frm_size_State01_test(hWnd01 As Long)

Dim lRet As Long

Dim lpWnd As WINDOWPLACEMENT

Dim str01 As String

With lpWnd

.Length = LenB(lpWnd)

lRet = GetWindowPlacement(hWnd01, lpWnd)

str01 = "フォームの表示状態："

If lRet <> 0 Then

If .ShowCmd = SW_SHOWMINIMIZED Then

str01 = str01 & "最小化サイズ" & vbCrLf

ElseIf .ShowCmd = SW_SHOWMAXIMIZED Then

str01 = str01 & "最大化サイズ" & vbCrLf

ElseIf .ShowCmd = SW_SHOWNORMAL Then

str01 = str01 & "通常サイズ" & vbCrLf

ElseIf .ShowCmd = SW_HIDE Then

str01 = str01 & "非表示" & vbCrLf

Else

str01 = str01 & "不明" & vbCrLf

End If

str01 = str01 & _

"通常サイズ時の座標(L,T)-(W,H)：" _

& "(" & .RcNormalPosition.Left & "," & .RcNormalPosition.Top & ")" _

& "-(" & .RcNormalPosition.Right & "," & .RcNormalPosition.Bottom & ")" & vbCrLf

str01 = str01 & _

"最大化サイズ時の座標(L,T)：" _

& "(" & .PtMaxPosition.X & "," & .PtMaxPosition.Y & ")" & vbCrLf

str01 = str01 & _

"最小化サイズ時の座標(L,T)：" _

& "(" & .PtMinPosition.X & "," & .PtMinPosition.Y & ")" & vbCrLf

Else

str01 = str01 & "取得エラー" & vbCrLf

End If

End With

Debug.Print str01

End Function

'#############################################################################

'現在開いているウィンドウたちを左右に並べて表示する関数

'事前に、VBEの参照設定にて

'「Microsoft Shell Controls And Automation」に

'照設定をしておきます。

'#############################################################################

Function Folder_Open()

'事前に、VBEの参照設定にて

'「Microsoft Shell Controls And Automation」に

'照設定をしておきます。

Dim objsample As Shell

Set objsample = New Shell

objsample.TileVertically 'Windows画面が分割表示されます。

Set objsample = Nothing '開放します。

End Function

'#############################################################################

'現在開いているウィンドウたちを上下に並べて表示する関数

'事前に、VBEの参照設定にて

'「Microsoft Shell Controls And Automation」に

'照設定をしておきます。

'#############################################################################

Function Folder_Open02()

Dim objsample01 As Shell

Set objsample01 = New Shell

objsample01.TileHorizontally 'Windows画面が分割表示されます。

Set objsample01 = Nothing '開放します。

End Function

#####################################################################################

★ 64bit/32bit「兼用」の２つのモジュール

'
'
Option Explicit


#If Win64 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If
'↑「Sleep」関数で、ミリ秒、待つためのAPIコード。


#If Win64 Then
 '【GetNextWindow関数】
    Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" _
    (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
 
 '【IsWindowVisible関数】
    Declare PtrSafe Function IsWindowVisible Lib "user32" _
    (ByVal hwnd As LongPtr) As LongPtr
 
 '【GetWindowText関数】
    Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As LongPtr
 
 '【FindWindow関数】
    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
 
    Dim hwnd As LongPtr
    
#Else
 '【GetNextWindow関数】
    Declare Function GetNextWindow Lib "user32" Alias "GetWindow" _
    (ByVal hwnd As Long, ByVal wFlag As Long) As Long
 
 '【IsWindowVisible関数】
    Declare Function IsWindowVisible Lib "user32" _
    (ByVal hwnd As Long) As Long
 
 '【GetWindowText関数】
    Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
 
 '【FindWindow関数】
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
    Dim hwnd As Long
 
#End If
 
Const GW_HWNDLAST = 1
Const GW_HWNDNEXT = 2

'-------------------------------------------------------------------------------------
'APIのWebページ付属のサンプルプログラム
'今回は、これを無理矢理に関数化しました。
'-------------------------------------------------------------------------------------
Sub main()
 
   
    Dim strCaption As String * 500
    
    hwnd = FindWindow(vbNullString, vbNullString)
    
    Dim caps As Collection
    Set caps = New Collection
    Dim cap 'As String
    Do
        If IsWindowVisible(hwnd) Then
        
            GetWindowText hwnd, strCaption, Len(strCaption)
            
            cap = Left(strCaption, InStr(strCaption, vbNullChar) - 1)
            If cap <> "" Then
                caps.Add cap
            End If
            
        End If
    
        hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)
    
    Loop Until hwnd = GetNextWindow(hwnd, GW_HWNDLAST)
    
    For Each cap In caps
        Debug.Print cap
    Next cap
 
End Sub


'###################################################################################
'ファイルの起動＋関数の呼び出し事例プログラム
'###################################################################################

Function FileBoot01(s_FilePath01 As String)

    Dim s_WindowTitle As String
    
    
    'ファイルを起動。
    With CreateObject("Shell.Application")
        .ShellExecute s_FilePath01
    End With
    
    
    
'    ' 起動を待つ  ’旧バージョンン。ダメだった。使えない。
'    Do Until objShell.AppActivate(objExec.ProcessID)
'        Sleep 1000
'        DoEvents
'        Debug.Print objExec.ProcessID
'        Debug.Print objShell.AppActivate(objExec.ProcessID)
'    Loop


    s_WindowTitle = WindowTitleGet01(Dir(s_FilePath01))
    '↑ウィンドウタイトルを取得。
    '　この「WindowTitleGet01」関数である程度、起動を「待つ」。
    
    Debug.Print s_WindowTitle & "-----★本番データ"
    
    Sleep 500     '（API）
    '↑さらに少し待つと、確実？なのか？
    '　とりあえず２秒も、３秒も待たなくて良い・・・、っぽい。
    
'    Let s_WindowTitle = "JUST PDF [編集] - [1.pdf]"
    
    AppActivate s_WindowTitle
    '↑ 目的のウィンドウタイトルのウィンドウをアクティブにする
    '　本当に効いているのかは少々疑問。
    '　　→コメントアウトしてテストしたら動かなかったので、結果、効いていたことになる。
    '　ただ、もしかしたら、場合によってはこのコード無くてもOKなケースもあるかもしれない。（未調査）
    
    
'    Debug.Print WindowTitleGet01(Dir(s_FilePath01)) & "---(A)"
    
    
    
'    Call app_window_risize01(0, 10, 300, 650)
    Call app_window_risize01(501, 10, 780, 650)
    '↑目的のウィンドウのリサイズ。
    
    
'    AppActivate WindowTitleGet01("ドラッグ")
'    Debug.Print WindowTitleGet01("ドラッグ")
'    '↑とりあえずのテストをしただけ。コメントアウト。

    
End Function

'###################################################################################
'ファイルの起動＋関数の呼び出し事例プログラム
'###################################################################################


Function WindowTitleGet01(s_ChkWord01 As String) As String

    Dim strCaption As String * 500
    '長さ500の文字列型変数の宣言
    
    Do
   
        strCaption = ""
        
        hwnd = FindWindow(vbNullString, vbNullString)
        
        
        '↓コレクションの生成
        Dim caps As Collection
        Dim cap 'As String
        Set caps = New Collection
        Do
            If IsWindowVisible(hwnd) Then
            
                GetWindowText hwnd, strCaption, Len(strCaption)
                
                cap = Left(strCaption, InStr(strCaption, vbNullChar) - 1)
                If cap <> "" Then
                    caps.Add cap
                End If
                
            End If
        
            hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)
        
        Loop Until hwnd = GetNextWindow(hwnd, GW_HWNDLAST)
        '↑コレクションの生成
        
        
        
        For Each cap In caps
        
'            Debug.Print cap & "---WTG-Function"
            
            If 1 <= InStr(1, cap, s_ChkWord01, vbBinaryCompare) Then
                WindowTitleGet01 = cap
                Set caps = Nothing
                Exit Function
            Else
            
            End If
        Next cap
        '↑コレクションの中に目的の検索文言を含むウィンドウタイトルがあるか調べ、
        '　あったらユーザーにそれを返してプロシージャも終わる。
        
        Set caps = Nothing
        'コレクションの消滅
    
    Loop
    
End Function


'********************************************
'********************************************
'以下、２つめのモジュール。
'********************************************
'********************************************

Option Explicit

'●Win64API　ウィンドウの最大化、最小化、等、状態の取得用の定義

Public Const SW_HIDE = 0
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWNORMAL = 1

'Type RECT
'    Left As Long
'    Top As Long
'    Right As Long
'    Bottom As Long
'End Type

'Type POINTAPI
'    X As Long
'    Y As Long
'End Type

'Type WINDOWPLACEMENT
'    Length As Long
'    Flags As Long
'    ShowCmd As Long
'    PtMinPosition As POINTAPI
'    PtMaxPosition As POINTAPI
'    RcNormalPosition As RECT
'End Type

Public Const WPF_RESTORETOMAXIMIZED = &H2
Public Const WPF_SETMINPOSITION = &H1

'Declare Function GetWindowPlacement Lib "user32" (ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long


'●Win64API　ウィンドの大きさ変更用の定義

#If Win64 Then
    Public Declare PtrSafe Function GetForegroundWindow Lib "user32" () As Long
#Else
    Public Declare Function GetForegroundWindow Lib "user32" () As Long
#End If



Public Type POINTAPI
    X As Long
    Y As Long
End Type

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Type WINDOWPLACEMENT
    Length As Long
    Flags As Long
    ShowCmd As Long
    PtMinPosition As POINTAPI
    PtMaxPosition As POINTAPI
    RcNormalPosition As RECT
End Type


#If Win64 Then
    Public Declare PtrSafe Function GetWindowPlacement Lib "user32" (ByVal hwnd As LongPtr, lpwndpl As WINDOWPLACEMENT) As Long
    Public Declare PtrSafe Function SetWindowPlacement Lib "user32" (ByVal hwnd As LongPtr, lpwndpl As WINDOWPLACEMENT) As Long
#Else
    Public Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
    Public Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
#End If


'●Win64API　ウィンドウの最前面表示用の定義
                                          
#If Win64 Then
    Declare PtrSafe Function FindWindow% Lib "user32" Alias "FindWindowA" _
                                              (ByVal lpClassName As Any, _
                                               ByVal lpCaption As Any)
                                               
'■「名前が適切ではありません」のエラーが出るので、コメントアウト。
'　　　（どことかぶってるかは未チェックです。多分、１つ目のモジュールの
'        64bitの分岐の「Declare PtrSafe Function FindWindow」。）

'    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
'      (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    
    
    Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, _
                                     ByVal hWndInsertAfter As LongPtr, _
                                     ByVal X As Long, _
                                     ByVal Y As Long, _
                                     ByVal cx As Long, _
                                     ByVal cy As Long, _
                                     ByVal wFlags As Long) As Long
#Else

    Declare Function FindWindow% Lib "user32" Alias "FindWindowA" _
                                              (ByVal lpClassName As Any, _
                                               ByVal lpCaption As Any)
                                               

    '■■チェック用。永遠にコメントアウト
'    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
'         (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
                                         
'■「名前が適切ではありません」のエラーが出るので、コメントアウト。
'　　　（どことかぶってるかは未チェックです。多分、１つ目のモジュールの
'        32bitの分岐の「Declare PtrSafe Function FindWindow」。）

'    Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
'          (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
                                        
    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 wFlags As Long) As Long
                                    
                                    
#End If


Global Const HWND_TOPMOST = -1   ' 最全面に表示する
Global Const HWND_NOTOPMOST = -2 ' 最前面に表示するのをやめる
Global Const SWP_NOSIZE = &H1    ' サイズを変更しない
Global Const SWP_NOMOVE = &H2    ' 位置を変更しない



'##########　　Win64/32APIの呼び出しはここまで　　################################################

'##########　　以下、Win64/32APIを呼び出すための関数（Win64/32APIを利用するための関数）　　################################################




'######################################################################################
'他のmdbのウィンドウを最前面にする関数
'win_hwnd には、「objAccess.hWndAccessApp」などで取得したウィンドウハンドルの値（Long型）を渡す
'hwndは Handle Of Window の略
'######################################################################################

Function window_most_top_on(win_hwnd As Long)

   Call SetWindowPos(win_hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

End Function

'######################################################################################
'他のmdbのウィンドウの最前面を解除する関数
'win_hwnd には、「objAccess.hWndAccessApp」などで取得したウィンドウハンドルの値（Long型）を渡す
''hwndは Handle Of Window の略
'######################################################################################


Function window_most_top_off(win_hwnd As Long)

   Call SetWindowPos(win_hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

End Function


'#################################################################
'自mdbを最前面に強制表示。
'#################################################################
Sub MeMdbSaiZenmenOn()
   Dim objAccess As Access.Application
   Set objAccess = CurrentProject.Application
   Call window_most_top_on(objAccess.hWndAccessApp)
End Sub

'#################################################################
'自mdbの最前面を強制表示解除。
'#################################################################
Sub MeMdbSaiZenmenOFF()
   Dim objAccess As Access.Application
   Set objAccess = CurrentProject.Application
   Call window_most_top_off(objAccess.hWndAccessApp)
End Sub


'######################################################################################

'●上記関数の呼び出しの使用例のコード
Sub testtest()
   Dim objAccess As Access.Application
   Set objAccess = CurrentProject.Application
   Call window_most_top_off(objAccess.hWndAccessApp)
End Sub

'######################################################################################

'●(02)自mdbを最前面にする使用例のコード
Sub test101()

   Dim objAccess As Access.Application
   Set objAccess = CurrentProject.Application
   Call SetWindowPos(objAccess.hWndAccessApp, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
   Set objAccess = Nothing
End Sub



'●(03)自mdbの最前面を解除する使用例のコード

Sub test102()
   Dim objAccess As Access.Application
   Set objAccess = CurrentProject.Application
   Call SetWindowPos(objAccess.hWndAccessApp, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
   Set objAccess = Nothing
End Sub


'###################################################################
'開いた何らかのアプリケーションをリサイズする関数
'タイトル名からリサイズする。
'タイトル名は全部じゃなくても一部でもOKみたいです。
'###################################################################

Function app_window_risize_for_title_name(active_title_name As String, _
                                          left_position As Integer, _
                                          Top_position As Integer, _
                                          Width_length As Integer, _
                                          Height_length As Integer)
    
    
''    Dim myHwnd As LongPtr '●●●●
'    Dim myHwnd As Long

    #If Win64 Then
        Dim myHwnd As LongPtr '●●●●64bit用
    #Else
        Dim myHwnd As Long '32bit用
    #End If


    Dim myWindowPlacement As WINDOWPLACEMENT


    '対象をアクティブにする。アクティブにしないと動かない。
'    AppActivate active_title_name
'    AppActivate "TeraPad"
    
    'ウィンドウハンドルの取得
    myHwnd = GetForegroundWindow()
    Debug.Print "myHwnd01---" & myHwnd '★★★★★★★★★★★★★★★
    
    'ウィンドウ情報の取得
    GetWindowPlacement myHwnd, myWindowPlacement
    'ウィンドウ情報を変更して設定
    With myWindowPlacement.RcNormalPosition
        .Left = left_position
        .Top = Top_position
        .Right = Width_length + left_position
        .Bottom = Height_length + Top_position
    End With
    
    Debug.Print "myHwnd02---" & myHwnd
    SetWindowPlacement myHwnd, myWindowPlacement

End Function



'###################################################################
'開いた何らかのアプリケーションをリサイズする関数。
'タスクID(プロセスID）からリサイズする。
'
'###################################################################

Function app_window_risize_for_p_id(p_id As Integer, _
                                    left_position As Integer, _
                                    Top_position As Integer, _
                                    Width_length As Integer, _
                                    Height_length As Integer)

''    Dim myHwnd As LongPtr '●●●●
'    Dim myHwnd As Long

    #If Win64 Then
        Dim myHwnd As LongPtr '●●●●64bit用
    #Else
        Dim myHwnd As Long '32bit用
    #End If


    Dim myWindowPlacement As WINDOWPLACEMENT


    '対象をアクティブにする。アクティブにしないと動かない。
    AppActivate p_id

    'ウィンドウハンドルの取得
    myHwnd = GetForegroundWindow()
    'ウィンドウ情報の取得
    GetWindowPlacement myHwnd, myWindowPlacement
    'ウィンドウ情報を変更して設定
    With myWindowPlacement.RcNormalPosition
        .Left = left_position
        .Top = Top_position
        .Right = Width_length + left_position
        .Bottom = Height_length + Top_position
    End With
    SetWindowPlacement myHwnd, myWindowPlacement

End Function



'###################################################################
'単純に自mdbのみをリサイズする関数。
'
'
'###################################################################

Function app_window_risize01(left_position As Integer, _
                                    Top_position As Integer, _
                                    Width_length As Integer, _
                                    Height_length As Integer)

    Dim myHwnd As Long
    Dim myWindowPlacement As WINDOWPLACEMENT

'
'    '対象をアクティブにする。アクティブにしないと動かない。
'    AppActivate p_id  ’←エラーになるのでコメントアウト。

    'ウィンドウハンドルの取得
    myHwnd = GetForegroundWindow()
    'ウィンドウ情報の取得
    GetWindowPlacement myHwnd, myWindowPlacement
    'ウィンドウ情報を変更して設定
    With myWindowPlacement.RcNormalPosition
        .Left = left_position
        .Top = Top_position
        .Right = Width_length + left_position
        .Bottom = Height_length + Top_position
    End With
    SetWindowPlacement myHwnd, myWindowPlacement

End Function



Function app_window_risize02(l_GetForegroundWindowNumber, _
                                    left_position As Integer, _
                                    Top_position As Integer, _
                                    Width_length As Integer, _
                                    Height_length As Integer)

    Dim myHwnd As Long
    Dim myWindowPlacement As WINDOWPLACEMENT

'
'    '対象をアクティブにする。アクティブにしないと動かない。
'    AppActivate p_id

    'ウィンドウハンドルの取得
'    myHwnd = GetForegroundWindow()
    myHwnd = l_GetForegroundWindowNumber
    'ウィンドウ情報の取得
    GetWindowPlacement myHwnd, myWindowPlacement
    'ウィンドウ情報を変更して設定
    With myWindowPlacement.RcNormalPosition
        .Left = left_position
        .Top = Top_position
        .Right = Width_length + left_position
        .Bottom = Height_length + Top_position
    End With
    SetWindowPlacement myHwnd, myWindowPlacement

End Function


'###################################################################
'開いているmdb内のフォームをリサイズする関数
'上記関数を変形しただけ。
'フォーム名をモトにリサイズする。
'
'###################################################################

Function form_api_risize(active_form_name As String, _
                         left_position As Integer, _
                         Top_position As Integer, _
                         Width_length As Integer, _
                         Height_length As Integer)

    Dim myHwnd As Long
    Dim myWindowPlacement As WINDOWPLACEMENT



    'フォームのウィンドウハンドルの取得
     myHwnd = Forms(active_form_name).hwnd

    'ウィンドウ情報の取得
    GetWindowPlacement myHwnd, myWindowPlacement

    'ウィンドウ情報を変更して設定
    With myWindowPlacement.RcNormalPosition
        .Left = left_position
        .Top = Top_position
        .Right = Width_length + left_position
        .Bottom = Height_length + Top_position
    End With
    SetWindowPlacement myHwnd, myWindowPlacement

End Function

'################################################################################
'フォームの状態を調べる関数（最大化、最小化、通常、非表示）
'hWnd01 はウィンドウハンドルを指定する。Me.Hwnd など。
'
'################################################################################

Function frm_size_State01(hWnd01 As Long) As String

    Dim lRet As Long
    Dim lpWnd As WINDOWPLACEMENT
    Dim str01 As String

    With lpWnd
        .Length = LenB(lpWnd)
        lRet = GetWindowPlacement(hWnd01, lpWnd)

        'str01 = "フォームの表示状態："
        If lRet <> 0 Then
            If .ShowCmd = SW_SHOWMINIMIZED Then
'                str01 = str01 & "最小化サイズ" & vbCrLf
                frm_size_State01 = "最小"
            ElseIf .ShowCmd = SW_SHOWMAXIMIZED Then
'                str01 = str01 & "最大化サイズ" & vbCrLf
                frm_size_State01 = "最大"
            ElseIf .ShowCmd = SW_SHOWNORMAL Then
'                str01 = str01 & "通常サイズ" & vbCrLf
                frm_size_State01 = "通常"
            ElseIf .ShowCmd = SW_HIDE Then
'                str01 = str01 & "非表示" & vbCrLf
                frm_size_State01 = "非表示"
            Else
'                str01 = str01 & "不明" & vbCrLf
                frm_size_State01 = "不明"
            End If

        Else
'            str01 = str01 & "取得エラー" & vbCrLf
                frm_size_State01 = "取得エラー"
        End If
    End With

End Function

'###################################################################
'上のコードの土台
'###################################################################

Function frm_size_State01_test(hWnd01 As Long)

    Dim lRet As Long
    Dim lpWnd As WINDOWPLACEMENT
    Dim str01 As String

    With lpWnd
        .Length = LenB(lpWnd)
        lRet = GetWindowPlacement(hWnd01, lpWnd)

        str01 = "フォームの表示状態："
        If lRet <> 0 Then
            If .ShowCmd = SW_SHOWMINIMIZED Then
                str01 = str01 & "最小化サイズ" & vbCrLf
            ElseIf .ShowCmd = SW_SHOWMAXIMIZED Then
                str01 = str01 & "最大化サイズ" & vbCrLf
            ElseIf .ShowCmd = SW_SHOWNORMAL Then
                str01 = str01 & "通常サイズ" & vbCrLf
            ElseIf .ShowCmd = SW_HIDE Then
                str01 = str01 & "非表示" & vbCrLf
            Else
                str01 = str01 & "不明" & vbCrLf
            End If
            str01 = str01 & _
                "通常サイズ時の座標(L,T)-(W,H)：" _
                & "(" & .RcNormalPosition.Left & "," & .RcNormalPosition.Top & ")" _
                & "-(" & .RcNormalPosition.Right & "," & .RcNormalPosition.Bottom & ")" & vbCrLf
            str01 = str01 & _
                "最大化サイズ時の座標(L,T)：" _
                & "(" & .PtMaxPosition.X & "," & .PtMaxPosition.Y & ")" & vbCrLf
            str01 = str01 & _
                "最小化サイズ時の座標(L,T)：" _
                & "(" & .PtMinPosition.X & "," & .PtMinPosition.Y & ")" & vbCrLf
        Else
            str01 = str01 & "取得エラー" & vbCrLf
        End If
    End With


    Debug.Print str01

End Function

'#############################################################################
'現在開いているウィンドウたちを左右に並べて表示する関数
    '事前に、VBEの参照設定にて
    '「Microsoft Shell Controls And Automation」に
    '照設定をしておきます。
'#############################################################################

Function Folder_Open()

    '事前に、VBEの参照設定にて
    '「Microsoft Shell Controls And Automation」に
    '照設定をしておきます。
    
    Dim objsample As Shell
    Set objsample = New Shell

    objsample.TileVertically 'Windows画面が分割表示されます。
    Set objsample = Nothing '開放します。

End Function

'#############################################################################
'現在開いているウィンドウたちを上下に並べて表示する関数
    '事前に、VBEの参照設定にて
    '「Microsoft Shell Controls And Automation」に
    '照設定をしておきます。
'#############################################################################

Function Folder_Open02()

    
    Dim objsample01 As Shell
    Set objsample01 = New Shell

    objsample01.TileHorizontally  'Windows画面が分割表示されます。
    Set objsample01 = Nothing '開放します。

End Function


'
'


'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425

426

427

428

429

430

431

432

433

434

435

436

437

438

439

440

441

442

443

444

445

446

447

448

449

450

451

452

453

454

455

456

457

458

459

460

461

462

463

464

465

466

467

468

469

470

471

472

473

474

475

476

477

478

479

480

481

482

483

484

485

486

487

488

489

490

491

492

493

494

495

496

497

498

499

500

501

502

503

504

505

506

507

508

509

510

511

512

513

514

515

516

517

518

519

520

521

522

523

524

525

526

527

528

529

530

531

532

533

534

535

536

537

538

539

540

541

542

543

544

545

546

547

548

549

550

551

552

553

554

555

556

557

558

559

560

561

562

563

564

565

566

567

568

569

570

571

572

573

574

575

576

577

578

579

580

581

582

583

584

585

586

587

588

589

590

591

592

593

594

595

596

597

598

599

600

601

602

603

604

605

606

607

608

609

610

611

612

613

614

615

616

617

618

619

620

621

622

623

624

625

626

627

628

629

630

631

632

633

634

635

636

637

638

639

640

641

642

643

644

645

646

647

648

649

650

651

652

653

654

655

656

657

658

659

660

661

662

663

664

665

666

667

668

669

670

671

672

673

674

675

676

677

678

679

680

681

682

683

684

685

686

687

688

689

690

691

692

693

694

695

696

697

698

699

700

701

702

703

704

705

706

707

708

709

710

711

712

713

714

715

716

717

718

719

720

721

722

723

724

725

726

727

728

729

730

731

732

733

734

735

736

737

738

739

740

741

742

743

744

745

746

747

748

749

750

751

752

753

754

755

756

757

758

759

760

761

762

763

764

765

766

767

768

769

770

771

772

773

774

Option Explicit

#If Win64 Then

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)

#Else

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

#End If

'↑「Sleep」関数で、ミリ秒、待つためのAPIコード。

#If Win64 Then

'【GetNextWindow関数】

Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" _

(ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr

'【IsWindowVisible関数】

Declare PtrSafe Function IsWindowVisible Lib "user32" _

(ByVal hwnd As LongPtr) As LongPtr

'【GetWindowText関数】

Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _

(ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As LongPtr

'【FindWindow関数】

Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _

(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Dim hwnd As LongPtr

#Else

'【GetNextWindow関数】

Declare Function GetNextWindow Lib "user32" Alias "GetWindow" _

(ByVal hwnd As Long, ByVal wFlag As Long) As Long

'【IsWindowVisible関数】

Declare Function IsWindowVisible Lib "user32" _

(ByVal hwnd As Long) As Long

'【GetWindowText関数】

Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _

(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

'【FindWindow関数】

Declare Function FindWindow Lib "user32" Alias "FindWindowA" _

(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Dim hwnd As Long

#End If

Const GW_HWNDLAST = 1

Const GW_HWNDNEXT = 2

'-------------------------------------------------------------------------------------

'APIのWebページ付属のサンプルプログラム

'今回は、これを無理矢理に関数化しました。

'-------------------------------------------------------------------------------------

Sub main()

Dim strCaption As String * 500

hwnd = FindWindow(vbNullString, vbNullString)

Dim caps As Collection

Set caps = New Collection

Dim cap 'As String

If IsWindowVisible(hwnd) Then

GetWindowText hwnd, strCaption, Len(strCaption)

cap = Left(strCaption, InStr(strCaption, vbNullChar) - 1)

If cap <> "" Then

caps.Add cap

End If

hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)

Loop Until hwnd = GetNextWindow(hwnd, GW_HWNDLAST)

For Each cap In caps

Debug.Print cap

Next cap

End Sub

'###################################################################################

'ファイルの起動＋関数の呼び出し事例プログラム

'###################################################################################

Function FileBoot01(s_FilePath01 As String)

Dim s_WindowTitle As String

'ファイルを起動。

With CreateObject("Shell.Application")

.ShellExecute s_FilePath01

End With

' ' 起動を待つ ’旧バージョンン。ダメだった。使えない。

' Do Until objShell.AppActivate(objExec.ProcessID)

' Sleep 1000

' DoEvents

' Debug.Print objExec.ProcessID

' Debug.Print objShell.AppActivate(objExec.ProcessID)

' Loop

s_WindowTitle = WindowTitleGet01(Dir(s_FilePath01))

'↑ウィンドウタイトルを取得。

'　この「WindowTitleGet01」関数である程度、起動を「待つ」。

Debug.Print s_WindowTitle & "-----★本番データ"

Sleep 500 '（API）

'↑さらに少し待つと、確実？なのか？

'　とりあえず２秒も、３秒も待たなくて良い・・・、っぽい。

' Let s_WindowTitle = "JUST PDF [編集] - [1.pdf]"

AppActivate s_WindowTitle

'↑ 目的のウィンドウタイトルのウィンドウをアクティブにする

'　本当に効いているのかは少々疑問。

'　　→コメントアウトしてテストしたら動かなかったので、結果、効いていたことになる。

'　ただ、もしかしたら、場合によってはこのコード無くてもOKなケースもあるかもしれない。（未調査）

' Debug.Print WindowTitleGet01(Dir(s_FilePath01)) & "---(A)"

' Call app_window_risize01(0, 10, 300, 650)

Call app_window_risize01(501, 10, 780, 650)

'↑目的のウィンドウのリサイズ。

' AppActivate WindowTitleGet01("ドラッグ")

' Debug.Print WindowTitleGet01("ドラッグ")

' '↑とりあえずのテストをしただけ。コメントアウト。

End Function

'###################################################################################

'ファイルの起動＋関数の呼び出し事例プログラム

'###################################################################################

Function WindowTitleGet01(s_ChkWord01 As String) As String

Dim strCaption As String * 500

'長さ500の文字列型変数の宣言

strCaption = ""

hwnd = FindWindow(vbNullString, vbNullString)

'↓コレクションの生成

Dim caps As Collection

Dim cap 'As String

Set caps = New Collection

If IsWindowVisible(hwnd) Then

GetWindowText hwnd, strCaption, Len(strCaption)

cap = Left(strCaption, InStr(strCaption, vbNullChar) - 1)

If cap <> "" Then

caps.Add cap

End If

hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)

Loop Until hwnd = GetNextWindow(hwnd, GW_HWNDLAST)

'↑コレクションの生成

For Each cap In caps

' Debug.Print cap & "---WTG-Function"

If 1 <= InStr(1, cap, s_ChkWord01, vbBinaryCompare) Then

WindowTitleGet01 = cap

Set caps = Nothing

Exit Function

Else

End If

Next cap

'↑コレクションの中に目的の検索文言を含むウィンドウタイトルがあるか調べ、

'　あったらユーザーにそれを返してプロシージャも終わる。

Set caps = Nothing

'コレクションの消滅

Loop

End Function

'********************************************

'以下、２つめのモジュール。

'********************************************

Option Explicit

'●Win64API　ウィンドウの最大化、最小化、等、状態の取得用の定義

Public Const SW_HIDE = 0

Public Const SW_SHOWMAXIMIZED = 3

Public Const SW_SHOWMINIMIZED = 2

Public Const SW_SHOWNORMAL = 1

'Type RECT

' Left As Long

' Top As Long

' Right As Long

' Bottom As Long

'End Type

'Type POINTAPI

' X As Long

' Y As Long

'End Type

'Type WINDOWPLACEMENT

' Length As Long

' Flags As Long

' ShowCmd As Long

' PtMinPosition As POINTAPI

' PtMaxPosition As POINTAPI

' RcNormalPosition As RECT

'End Type

Public Const WPF_RESTORETOMAXIMIZED = &H2

Public Const WPF_SETMINPOSITION = &H1

'Declare Function GetWindowPlacement Lib "user32" (ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long

'●Win64API　ウィンドの大きさ変更用の定義

#If Win64 Then

Public Declare PtrSafe Function GetForegroundWindow Lib "user32" () As Long

#Else

Public Declare Function GetForegroundWindow Lib "user32" () As Long

#End If

Public Type POINTAPI

X As Long

Y As Long

End Type

Public Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Public Type WINDOWPLACEMENT

Length As Long

Flags As Long

ShowCmd As Long

PtMinPosition As POINTAPI

PtMaxPosition As POINTAPI

RcNormalPosition As RECT

End Type

#If Win64 Then

Public Declare PtrSafe Function GetWindowPlacement Lib "user32" (ByVal hwnd As LongPtr, lpwndpl As WINDOWPLACEMENT) As Long

Public Declare PtrSafe Function SetWindowPlacement Lib "user32" (ByVal hwnd As LongPtr, lpwndpl As WINDOWPLACEMENT) As Long

#Else

Public Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long

Public Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long

#End If

'●Win64API　ウィンドウの最前面表示用の定義

#If Win64 Then

Declare PtrSafe Function FindWindow% Lib "user32" Alias "FindWindowA" _

(ByVal lpClassName As Any, _

ByVal lpCaption As Any)

'■「名前が適切ではありません」のエラーが出るので、コメントアウト。

'　　　（どことかぶってるかは未チェックです。多分、１つ目のモジュールの

' 64bitの分岐の「Declare PtrSafe Function FindWindow」。）

' Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _

' (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, _

ByVal hWndInsertAfter As LongPtr, _

ByVal X As Long, _

ByVal Y As Long, _

ByVal cx As Long, _

ByVal cy As Long, _

ByVal wFlags As Long) As Long

#Else

Declare Function FindWindow% Lib "user32" Alias "FindWindowA" _

(ByVal lpClassName As Any, _

ByVal lpCaption As Any)

'■■チェック用。永遠にコメントアウト

' Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _

' (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

'■「名前が適切ではありません」のエラーが出るので、コメントアウト。

'　　　（どことかぶってるかは未チェックです。多分、１つ目のモジュールの

' 32bitの分岐の「Declare PtrSafe Function FindWindow」。）

' Declare Function FindWindow Lib "user32" Alias "FindWindowA" _

' (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

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 wFlags As Long) As Long

#End If

Global Const HWND_TOPMOST = -1 ' 最全面に表示する

Global Const HWND_NOTOPMOST = -2 ' 最前面に表示するのをやめる

Global Const SWP_NOSIZE = &H1 ' サイズを変更しない

Global Const SWP_NOMOVE = &H2 ' 位置を変更しない

'##########　　Win64/32APIの呼び出しはここまで　　################################################

'##########　　以下、Win64/32APIを呼び出すための関数（Win64/32APIを利用するための関数）　　################################################

'######################################################################################

'他のmdbのウィンドウを最前面にする関数

'win_hwnd には、「objAccess.hWndAccessApp」などで取得したウィンドウハンドルの値（Long型）を渡す

'hwndは Handle Of Window の略

'######################################################################################

Function window_most_top_on(win_hwnd As Long)

Call SetWindowPos(win_hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

End Function

'######################################################################################

'他のmdbのウィンドウの最前面を解除する関数

'win_hwnd には、「objAccess.hWndAccessApp」などで取得したウィンドウハンドルの値（Long型）を渡す

''hwndは Handle Of Window の略

'######################################################################################

Function window_most_top_off(win_hwnd As Long)

Call SetWindowPos(win_hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

End Function

'#################################################################

'自mdbを最前面に強制表示。

'#################################################################

Sub MeMdbSaiZenmenOn()

Dim objAccess As Access.Application

Set objAccess = CurrentProject.Application

Call window_most_top_on(objAccess.hWndAccessApp)

End Sub

'#################################################################

'自mdbの最前面を強制表示解除。

'#################################################################

Sub MeMdbSaiZenmenOFF()

Dim objAccess As Access.Application

Set objAccess = CurrentProject.Application

Call window_most_top_off(objAccess.hWndAccessApp)

End Sub

'######################################################################################

'●上記関数の呼び出しの使用例のコード

Sub testtest()

Dim objAccess As Access.Application

Set objAccess = CurrentProject.Application

Call window_most_top_off(objAccess.hWndAccessApp)

End Sub

'######################################################################################

'●(02)自mdbを最前面にする使用例のコード

Sub test101()

Dim objAccess As Access.Application

Set objAccess = CurrentProject.Application

Call SetWindowPos(objAccess.hWndAccessApp, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

Set objAccess = Nothing

End Sub

'●(03)自mdbの最前面を解除する使用例のコード

Sub test102()

Dim objAccess As Access.Application

Set objAccess = CurrentProject.Application

Call SetWindowPos(objAccess.hWndAccessApp, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

Set objAccess = Nothing

End Sub

'###################################################################

'開いた何らかのアプリケーションをリサイズする関数

'タイトル名からリサイズする。

'タイトル名は全部じゃなくても一部でもOKみたいです。

'###################################################################

Function app_window_risize_for_title_name(active_title_name As String, _

left_position As Integer, _

Top_position As Integer, _

Width_length As Integer, _

Height_length As Integer)

'' Dim myHwnd As LongPtr '●●●●

' Dim myHwnd As Long

#If Win64 Then

Dim myHwnd As LongPtr '●●●●64bit用

#Else

Dim myHwnd As Long '32bit用

#End If

Dim myWindowPlacement As WINDOWPLACEMENT

'対象をアクティブにする。アクティブにしないと動かない。

' AppActivate active_title_name

' AppActivate "TeraPad"

'ウィンドウハンドルの取得

myHwnd = GetForegroundWindow()

Debug.Print "myHwnd01---" & myHwnd '★★★★★★★★★★★★★★★

'ウィンドウ情報の取得

GetWindowPlacement myHwnd, myWindowPlacement

'ウィンドウ情報を変更して設定

With myWindowPlacement.RcNormalPosition

.Left = left_position

.Top = Top_position

.Right = Width_length + left_position

.Bottom = Height_length + Top_position

End With

Debug.Print "myHwnd02---" & myHwnd

SetWindowPlacement myHwnd, myWindowPlacement

End Function

'###################################################################

'開いた何らかのアプリケーションをリサイズする関数。

'タスクID(プロセスID）からリサイズする。

'###################################################################

Function app_window_risize_for_p_id(p_id As Integer, _

left_position As Integer, _

Top_position As Integer, _

Width_length As Integer, _

Height_length As Integer)

'' Dim myHwnd As LongPtr '●●●●

' Dim myHwnd As Long

#If Win64 Then

Dim myHwnd As LongPtr '●●●●64bit用

#Else

Dim myHwnd As Long '32bit用

#End If

Dim myWindowPlacement As WINDOWPLACEMENT

'対象をアクティブにする。アクティブにしないと動かない。

AppActivate p_id

'ウィンドウハンドルの取得

myHwnd = GetForegroundWindow()

'ウィンドウ情報の取得

GetWindowPlacement myHwnd, myWindowPlacement

'ウィンドウ情報を変更して設定

With myWindowPlacement.RcNormalPosition

.Left = left_position

.Top = Top_position

.Right = Width_length + left_position

.Bottom = Height_length + Top_position

End With

SetWindowPlacement myHwnd, myWindowPlacement

End Function

'###################################################################

'単純に自mdbのみをリサイズする関数。

'###################################################################

Function app_window_risize01(left_position As Integer, _

Top_position As Integer, _

Width_length As Integer, _

Height_length As Integer)

Dim myHwnd As Long

Dim myWindowPlacement As WINDOWPLACEMENT

' '対象をアクティブにする。アクティブにしないと動かない。

' AppActivate p_id ’←エラーになるのでコメントアウト。

'ウィンドウハンドルの取得

myHwnd = GetForegroundWindow()

'ウィンドウ情報の取得

GetWindowPlacement myHwnd, myWindowPlacement

'ウィンドウ情報を変更して設定

With myWindowPlacement.RcNormalPosition

.Left = left_position

.Top = Top_position

.Right = Width_length + left_position

.Bottom = Height_length + Top_position

End With

SetWindowPlacement myHwnd, myWindowPlacement

End Function

Function app_window_risize02(l_GetForegroundWindowNumber, _

left_position As Integer, _

Top_position As Integer, _

Width_length As Integer, _

Height_length As Integer)

Dim myHwnd As Long

Dim myWindowPlacement As WINDOWPLACEMENT

' '対象をアクティブにする。アクティブにしないと動かない。

' AppActivate p_id

'ウィンドウハンドルの取得

' myHwnd = GetForegroundWindow()

myHwnd = l_GetForegroundWindowNumber

'ウィンドウ情報の取得

GetWindowPlacement myHwnd, myWindowPlacement

'ウィンドウ情報を変更して設定

With myWindowPlacement.RcNormalPosition

.Left = left_position

.Top = Top_position

.Right = Width_length + left_position

.Bottom = Height_length + Top_position

End With

SetWindowPlacement myHwnd, myWindowPlacement

End Function

'###################################################################

'開いているmdb内のフォームをリサイズする関数

'上記関数を変形しただけ。

'フォーム名をモトにリサイズする。

'###################################################################

Function form_api_risize(active_form_name As String, _

left_position As Integer, _

Top_position As Integer, _

Width_length As Integer, _

Height_length As Integer)

Dim myHwnd As Long

Dim myWindowPlacement As WINDOWPLACEMENT

'フォームのウィンドウハンドルの取得

myHwnd = Forms(active_form_name).hwnd

'ウィンドウ情報の取得

GetWindowPlacement myHwnd, myWindowPlacement

'ウィンドウ情報を変更して設定

With myWindowPlacement.RcNormalPosition

.Left = left_position

.Top = Top_position

.Right = Width_length + left_position

.Bottom = Height_length + Top_position

End With

SetWindowPlacement myHwnd, myWindowPlacement

End Function

'################################################################################

'フォームの状態を調べる関数（最大化、最小化、通常、非表示）

'hWnd01 はウィンドウハンドルを指定する。Me.Hwnd など。

'################################################################################

Function frm_size_State01(hWnd01 As Long) As String

Dim lRet As Long

Dim lpWnd As WINDOWPLACEMENT

Dim str01 As String

With lpWnd

.Length = LenB(lpWnd)

lRet = GetWindowPlacement(hWnd01, lpWnd)

'str01 = "フォームの表示状態："

If lRet <> 0 Then

If .ShowCmd = SW_SHOWMINIMIZED Then

' str01 = str01 & "最小化サイズ" & vbCrLf

frm_size_State01 = "最小"

ElseIf .ShowCmd = SW_SHOWMAXIMIZED Then

' str01 = str01 & "最大化サイズ" & vbCrLf

frm_size_State01 = "最大"

ElseIf .ShowCmd = SW_SHOWNORMAL Then

' str01 = str01 & "通常サイズ" & vbCrLf

frm_size_State01 = "通常"

ElseIf .ShowCmd = SW_HIDE Then

' str01 = str01 & "非表示" & vbCrLf

frm_size_State01 = "非表示"

Else

' str01 = str01 & "不明" & vbCrLf

frm_size_State01 = "不明"

End If

Else

' str01 = str01 & "取得エラー" & vbCrLf

frm_size_State01 = "取得エラー"

End If

End With

End Function

'###################################################################

'上のコードの土台

'###################################################################

Function frm_size_State01_test(hWnd01 As Long)

Dim lRet As Long

Dim lpWnd As WINDOWPLACEMENT

Dim str01 As String

With lpWnd

.Length = LenB(lpWnd)

lRet = GetWindowPlacement(hWnd01, lpWnd)

str01 = "フォームの表示状態："

If lRet <> 0 Then

If .ShowCmd = SW_SHOWMINIMIZED Then

str01 = str01 & "最小化サイズ" & vbCrLf

ElseIf .ShowCmd = SW_SHOWMAXIMIZED Then

str01 = str01 & "最大化サイズ" & vbCrLf

ElseIf .ShowCmd = SW_SHOWNORMAL Then

str01 = str01 & "通常サイズ" & vbCrLf

ElseIf .ShowCmd = SW_HIDE Then

str01 = str01 & "非表示" & vbCrLf

Else

str01 = str01 & "不明" & vbCrLf

End If

str01 = str01 & _

"通常サイズ時の座標(L,T)-(W,H)：" _

& "(" & .RcNormalPosition.Left & "," & .RcNormalPosition.Top & ")" _

& "-(" & .RcNormalPosition.Right & "," & .RcNormalPosition.Bottom & ")" & vbCrLf

str01 = str01 & _

"最大化サイズ時の座標(L,T)：" _

& "(" & .PtMaxPosition.X & "," & .PtMaxPosition.Y & ")" & vbCrLf

str01 = str01 & _

"最小化サイズ時の座標(L,T)：" _

& "(" & .PtMinPosition.X & "," & .PtMinPosition.Y & ")" & vbCrLf

Else

str01 = str01 & "取得エラー" & vbCrLf

End If

End With

Debug.Print str01

End Function

'#############################################################################

'現在開いているウィンドウたちを左右に並べて表示する関数

'事前に、VBEの参照設定にて

'「Microsoft Shell Controls And Automation」に

'照設定をしておきます。

'#############################################################################

Function Folder_Open()

'事前に、VBEの参照設定にて

'「Microsoft Shell Controls And Automation」に

'照設定をしておきます。

Dim objsample As Shell

Set objsample = New Shell

objsample.TileVertically 'Windows画面が分割表示されます。

Set objsample = Nothing '開放します。

End Function

'#############################################################################

'現在開いているウィンドウたちを上下に並べて表示する関数

'事前に、VBEの参照設定にて

'「Microsoft Shell Controls And Automation」に

'照設定をしておきます。

'#############################################################################

Function Folder_Open02()

Dim objsample01 As Shell

Set objsample01 = New Shell

objsample01.TileHorizontally 'Windows画面が分割表示されます。

Set objsample01 = Nothing '開放します。

End Function

投稿タグ: ExcelVBA, パソコンでの自動化, マクロ, 独学, 自動化

MENU

関連記事

最近の投稿

カテゴリー

MENU

関連記事

最近の投稿

カテゴリー

タグ