Access2000Tips Win32 API サブフォームの大きさをAccessウィンドウの大きさの変化に伴いフィットさせたり、ウィンドウのサイズ自体を変更したり、最前面を固定化したり、のサンプルダウンロード

● Access2000Tips Win32 API サブフォームの大きさをAccessウィンドウの大きさの変化に伴いフィットさせたり、ウィンドウのサイズ自体を変更したり、最前面を固定化したり、のサンプルダウンロード
　　
　　

★ サンプルのダウンロード
（ESETでウィルスチェックしてあります）
(01)「サブフォームフィット例.mdb」
(02)「Access2000ランタイムダウンロード」

※ランタイムはバージョン2000のものです。Access2000を持っていない方でも、サンプルのmdb（ここでは「サブフォームフィット例.mdb」）の動作の確認をしていただけます。
ただ、Win10で動くかはまだチェックしていません。仮想マシンのXPなどで動かすほうが確実かと思います。
なお、仮想マシンの中ではAccessランタイムでの動作では、「Accessウィンドウ（ガワ）の大きさを変える」ボタンでエラーになってしまいました。そのほかは動くようです。仮想マシンでないマシン上で正常動作するかもチェックはしていません。
ランタイムではないAccess2000ならエラーにはならないと思います。
　　
　　

　　

　　
　　　↑
　　　↓
　　

★ フォームのイベントプロシージャの内容

'
'
Option Compare Database
Option Explicit

Private Sub btnAppWinScaling_Click()

    If IsNull(Me("tbx左位置").Value) = True _
        Or IsNull(Me("tbx上位置").Value) = True _
        Or IsNull(Me("tbx幅").Value) = True _
        Or IsNull(Me("tbx高さ").Value) = True Then
        'テキストボックスに空欄があったら以下の処理をします。
        
        MsgBox "数値が入力されていないテキストボックスがあります。すべてのテキストボックスにピクセル単位で数値を入力してください"
        'メッセージの表示
        
        Exit Sub
        'プログラムを終わる
        
    Else
        'ちゃんと全部埋まっていれば何もせず次へ
    
    End If
    

    Call app_window_risize_for_title_name("Microsoft Access", _
                                            Me("tbx左位置").Value, _
                                            Me("tbx上位置").Value, _
                                            Me("tbx幅").Value, _
                                            Me("tbx高さ").Value)
    
    'Accessの「ガワ」のウィンドウの調整をします。
    '("ウィンドウのタイトルバーの一部の文字列", 左位置, 上位置, 幅, 高さ)
    '数値はtwipではなくてピクセルです。
    
    'なお、自ウィンドウではなくて他のウィンドウの大きさを変えたいときは、
    '「"Microsoft Access"」の部分を変えればOKです。
    
    'もちろん、そのウィドウが既に開いていることが前提ですが、
    'たとえば既に開いているメモ帳のウィンドウの大きさを変えたいときは
    '「"Microsoft Access"」を「"メモ帳"」とします。
    '※タイトルバーの一部の文字列の指定でよいと思います。
    
    
End Sub

Private Sub Form_Resize()

    '最小化すると何故かCPUの使用率が100%になってしまうのでそれを回避
    '（Win32API使用）
    
    If frm_size_State01(Me.hWnd) = "最小" Then
        Exit Sub
    ElseIf frm_size_State01(Me.hWnd) = "不明" Then
        Exit Sub
    ElseIf frm_size_State01(Me.hWnd) = "取得エラー" Then
        Exit Sub
    Else

    End If

    '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
    'これ以降のプログラムは、実際に、サブフォームの大きさを
    'フィットさせる処理ですが、本当はWin32APIなしでもOKです。
    'ウィンドウを最小化する事がないないなら、
    'Win32API（これより上のプログラム）は要りません。
    '（ここでは最小化することを前提としているので、
    '　　上記のWin32APIのコードも追記してあります。）
    'また、あまりウィンドウを小さくするとサブフォームの大きさがゼロよりも
    '小さくなってしまうのか、よくわかりませんが、エラーになります。
    'そのときのエラー処理は書いてませんので、ご自分で書いてみてください。
    'エラーになったらExit　Subでプログラムを終了させればOKかと思います。


    '●フォームの詳細セクションの大きさの調整
    '（フォームヘッダやフォームフッタの大きさは変わりません。
    
    Me.Width = Me.InsideWidth
    '詳細セクションには幅のプロパティが無いのでMe.（フォーム）で幅を調整
    'このコードはなくてもエラーにならないかもです。
    
    Me.詳細.Height = Me.InsideHeight - Me.フォームヘッダー.Height - Me.フォームフッター.Height - 800
    '最後のマイナスの数値の1000(twip)は、
    '「埋め込みとしてのガワ01」のHeightの数字と同じくらいか、
    '少し小さくするといいみたい。
    'あまり数字が大きくても小さくてもエラーになるっぽいです。
    '「= Me.InsideHeight - 」じゃなくて、「= Me.詳細.Height - 」でもいいかも。


    
    On Error Resume Next
    '最小化時にここでエラーになるので回避
    
    
    
    '●サブフォームの大きさの調整
    
    Me.埋め込みとしてのガワ01.Width = Me.InsideWidth - 500
    '最後のマイナスの数値が500よりも低すぎると、
    'サブフォームの右端の縦方向のスクロールバーが隠れてしまい、
    '切れた感じになるので注意。
    '数字はピクセルではなくて、twipです。
        
    Me.埋め込みとしてのガワ01.Height = Me.InsideHeight - Me.フォームヘッダー.Height - Me.フォームフッター.Height - 1000
    '最後のマイナスの数値を1000以下にすると、サブフォームの下側の
    '横方向のスクロールバーが下に隠れてしまう場合もあるので注意。
    '数字はピクセルではなくて、twipです。
    '「= Me.InsideHeight - 」じゃなくて、「= Me.埋め込みとしてのガワ01.Height - 」でもいいかも。

End Sub

Private Sub btnWinTileDisplay_Click()
    '現在開いているウィンドウたちを左右に並べて表示します
    Call Folder_Open
End Sub


Private Sub btnAtherWinScaling_Click()

    Dim AppName     As String
    
On Error GoTo error1:

    

    AppName = InputBox("画面サイズを変えたいソフトの名前（タイトルバーの文字列に在るソフト名）を入力してください。例えばメモ帳なら「メモ帳」と入力してください。半角スペースがある場合はそれも入力します。" & vbCrLf & vbCrLf & "※ソフトによっては、ファイル名でもOKな場合もあります。拡張子がある場合は拡張子も含めます。")
    'どんなソフトを画面の位置や大きさを変えたいか、ユーザーに聞きます。
    'Inputboxに入力された文字は変数「Answ01」に代入されます。
    'キャンセルボタンが押されたときは、「Answ01」には「""」が代入されます。
    
    
    
    If AppName = "" Then
        'Answ01に""が代入された＝キャンセルされたときは以下の処理
        
        MsgBox "キャンセルされたので中断します。"
        'メッセージを出して
        
        Exit Sub
        'プログラムを終わります。
        
    Else
        '何らかのソフト名が入力された場合は何もしないで次へ
    
    End If

    
'    AppActivate AppName, False
'    '指定された他のソフトのウィンドウをアクティブにします。
'
    Call app_window_risize_for_title_name(AppName, _
                                        Me("tbx左位置").Value, _
                                        Me("tbx上位置").Value, _
                                        Me("tbx幅").Value, _
                                        Me("tbx高さ").Value)
    
    'Accessの「ガワ」のウィンドウの調整をします。
    '("ウィンドウのタイトルバーの一部の文字列", 左位置, 上位置, 幅, 高さ)
    '数値はtwipではなくてピクセルです。
    
    'なお、自ウィンドウではなくて他のウィンドウの大きさを変えたいときは、
    '「"Microsoft Access"」の部分を変えればOKです。
    
    'もちろん、そのウィドウが既に開いていることが前提ですが、
    'たとえば既に開いているメモ帳のウィンドウの大きさを変えたいときは
    '「"Microsoft Access"」を「"メモ帳"」とします。
    '※タイトルバーの一部の文字列の指定でよいと思います。

Exit Sub

error1:

    If Err.Number = 5 Then
    '指定したソフトが開いていない場合は、エラー番号が5のエラーになるので
    '以下の処理をします。
    
        MsgBox "入力したソフトが起動していないかソフトの名前が違うようです。再度やり直してください。"
        Exit Sub
        
    Else
        'エラー番号が何であってもこわいので一応終わっておきます。
        Exit Sub
    End If

    
End Sub

Private Sub btnAppWinFrontLock_Click()

    '今のAccessのウィンドウを最前面に固定します。
    '4行でワンセットです。
    'ウィンドウの位置の移動や大きさの変更などをするとか、
    '何らかのメッセージを表示させたりすると、自動解除されるみたいです。
    'ウィンドウの中のもの（ボタンやサブフォーム）などを操作しているあいだは
    'メッセージさえ出なければ最前面の固定を維持できるようです。
    
    Dim objAccess01 As Access.Application
    
    Set objAccess01 = CurrentProject.Application
    Call SetWindowPos(objAccess01.hWndAccessApp, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    Set objAccess01 = Nothing
    
End Sub

Private Sub btnAppWinFrontUnlock_Click()

    '今のAccessのウィンドウの最前面の固定を解除します。
    '4行でワンセットです。
    
    Dim objAccess02 As Access.Application
    
    Set objAccess02 = CurrentProject.Application
    Call SetWindowPos(objAccess02.hWndAccessApp, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    Set objAccess02 = Nothing
    
End Sub
'
'

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

Option Compare Database

Option Explicit

Private Sub btnAppWinScaling_Click()

If IsNull(Me("tbx左位置").Value) = True _

Or IsNull(Me("tbx上位置").Value) = True _

Or IsNull(Me("tbx幅").Value) = True _

Or IsNull(Me("tbx高さ").Value) = True Then

'テキストボックスに空欄があったら以下の処理をします。

MsgBox "数値が入力されていないテキストボックスがあります。すべてのテキストボックスにピクセル単位で数値を入力してください"

'メッセージの表示

Exit Sub

'プログラムを終わる

Else

'ちゃんと全部埋まっていれば何もせず次へ

End If

Call app_window_risize_for_title_name("Microsoft Access", _

Me("tbx左位置").Value, _

Me("tbx上位置").Value, _

Me("tbx幅").Value, _

Me("tbx高さ").Value)

'Accessの「ガワ」のウィンドウの調整をします。

'("ウィンドウのタイトルバーの一部の文字列", 左位置, 上位置, 幅, 高さ)

'数値はtwipではなくてピクセルです。

'なお、自ウィンドウではなくて他のウィンドウの大きさを変えたいときは、

'「"Microsoft Access"」の部分を変えればOKです。

'もちろん、そのウィドウが既に開いていることが前提ですが、

'たとえば既に開いているメモ帳のウィンドウの大きさを変えたいときは

'「"Microsoft Access"」を「"メモ帳"」とします。

'※タイトルバーの一部の文字列の指定でよいと思います。

End Sub

Private Sub Form_Resize()

'最小化すると何故かCPUの使用率が100%になってしまうのでそれを回避

'（Win32API使用）

If frm_size_State01(Me.hWnd) = "最小" Then

Exit Sub

ElseIf frm_size_State01(Me.hWnd) = "不明" Then

Exit Sub

ElseIf frm_size_State01(Me.hWnd) = "取得エラー" Then

Exit Sub

Else

End If

'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

'これ以降のプログラムは、実際に、サブフォームの大きさを

'フィットさせる処理ですが、本当はWin32APIなしでもOKです。

'ウィンドウを最小化する事がないないなら、

'Win32API（これより上のプログラム）は要りません。

'（ここでは最小化することを前提としているので、

'　　上記のWin32APIのコードも追記してあります。）

'また、あまりウィンドウを小さくするとサブフォームの大きさがゼロよりも

'小さくなってしまうのか、よくわかりませんが、エラーになります。

'そのときのエラー処理は書いてませんので、ご自分で書いてみてください。

'エラーになったらExit　Subでプログラムを終了させればOKかと思います。

'●フォームの詳細セクションの大きさの調整

'（フォームヘッダやフォームフッタの大きさは変わりません。

Me.Width = Me.InsideWidth

'詳細セクションには幅のプロパティが無いのでMe.（フォーム）で幅を調整

'このコードはなくてもエラーにならないかもです。

Me.詳細.Height = Me.InsideHeight - Me.フォームヘッダー.Height - Me.フォームフッター.Height - 800

'最後のマイナスの数値の1000(twip)は、

'「埋め込みとしてのガワ01」のHeightの数字と同じくらいか、

'少し小さくするといいみたい。

'あまり数字が大きくても小さくてもエラーになるっぽいです。

'「= Me.InsideHeight - 」じゃなくて、「= Me.詳細.Height - 」でもいいかも。

On Error Resume Next

'最小化時にここでエラーになるので回避

'●サブフォームの大きさの調整

Me.埋め込みとしてのガワ01.Width = Me.InsideWidth - 500

'最後のマイナスの数値が500よりも低すぎると、

'サブフォームの右端の縦方向のスクロールバーが隠れてしまい、

'切れた感じになるので注意。

'数字はピクセルではなくて、twipです。

Me.埋め込みとしてのガワ01.Height = Me.InsideHeight - Me.フォームヘッダー.Height - Me.フォームフッター.Height - 1000

'最後のマイナスの数値を1000以下にすると、サブフォームの下側の

'横方向のスクロールバーが下に隠れてしまう場合もあるので注意。

'数字はピクセルではなくて、twipです。

'「= Me.InsideHeight - 」じゃなくて、「= Me.埋め込みとしてのガワ01.Height - 」でもいいかも。

End Sub

Private Sub btnWinTileDisplay_Click()

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

Call Folder_Open

End Sub

Private Sub btnAtherWinScaling_Click()

Dim AppName As String

On Error GoTo error1:

AppName = InputBox("画面サイズを変えたいソフトの名前（タイトルバーの文字列に在るソフト名）を入力してください。例えばメモ帳なら「メモ帳」と入力してください。半角スペースがある場合はそれも入力します。" & vbCrLf & vbCrLf & "※ソフトによっては、ファイル名でもOKな場合もあります。拡張子がある場合は拡張子も含めます。")

'どんなソフトを画面の位置や大きさを変えたいか、ユーザーに聞きます。

'Inputboxに入力された文字は変数「Answ01」に代入されます。

'キャンセルボタンが押されたときは、「Answ01」には「""」が代入されます。

If AppName = "" Then

'Answ01に""が代入された＝キャンセルされたときは以下の処理

MsgBox "キャンセルされたので中断します。"

'メッセージを出して

Exit Sub

'プログラムを終わります。

Else

'何らかのソフト名が入力された場合は何もしないで次へ

End If

' AppActivate AppName, False

' '指定された他のソフトのウィンドウをアクティブにします。

Call app_window_risize_for_title_name(AppName, _

Me("tbx左位置").Value, _

Me("tbx上位置").Value, _

Me("tbx幅").Value, _

Me("tbx高さ").Value)

'Accessの「ガワ」のウィンドウの調整をします。

'("ウィンドウのタイトルバーの一部の文字列", 左位置, 上位置, 幅, 高さ)

'数値はtwipではなくてピクセルです。

'なお、自ウィンドウではなくて他のウィンドウの大きさを変えたいときは、

'「"Microsoft Access"」の部分を変えればOKです。

'もちろん、そのウィドウが既に開いていることが前提ですが、

'たとえば既に開いているメモ帳のウィンドウの大きさを変えたいときは

'「"Microsoft Access"」を「"メモ帳"」とします。

'※タイトルバーの一部の文字列の指定でよいと思います。

Exit Sub

error1:

If Err.Number = 5 Then

'指定したソフトが開いていない場合は、エラー番号が5のエラーになるので

'以下の処理をします。

MsgBox "入力したソフトが起動していないかソフトの名前が違うようです。再度やり直してください。"

Exit Sub

Else

'エラー番号が何であってもこわいので一応終わっておきます。

Exit Sub

End If

End Sub

Private Sub btnAppWinFrontLock_Click()

'今のAccessのウィンドウを最前面に固定します。

'4行でワンセットです。

'ウィンドウの位置の移動や大きさの変更などをするとか、

'何らかのメッセージを表示させたりすると、自動解除されるみたいです。

'ウィンドウの中のもの（ボタンやサブフォーム）などを操作しているあいだは

'メッセージさえ出なければ最前面の固定を維持できるようです。

Dim objAccess01 As Access.Application

Set objAccess01 = CurrentProject.Application

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

Set objAccess01 = Nothing

End Sub

Private Sub btnAppWinFrontUnlock_Click()

'今のAccessのウィンドウの最前面の固定を解除します。

'4行でワンセットです。

Dim objAccess02 As Access.Application

Set objAccess02 = CurrentProject.Application

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

Set objAccess02 = Nothing

End Sub

★ Win32APIのプログラム
以下のコードを、Accessの標準モジュールを1個つくってコピペして使ってください。
イベントプロシージャや標準モジュールのプロシージャから呼び出せば、以下のようなことができます。

(a)サブフォームの大きさをAccessウィンドウの大きさの変化に伴って
　　連動フィットさせる場合の、最小化時のエラーやCPU使用率100%の回避
(b)自mdbのウィンドウのサイズ自体を変更
(c)他mdbのウィンドウのサイズを変更
(d)メモ帳などの他のソフトのウィンドウのサイズをAccessから変更
(e)自mdbの画面（Access画面丸ごと）の「最前面」設定の固定化
(f)デスクトップに開いている各ソフトのウィンドウを左右に並べる（4分割以上）
(g)同じく上下に並べる

※ 最後の2つの(f)と(g)は、事前に、VBEの参照設定にて「Microsoft Shell Controls And Automation」に照設定をしておきます。APIとは関係ありません。

'
'
Option Compare Database
Option Explicit

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

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


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

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 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



'●Win32API　ウィンドウの最前面表示用の定義
                                          
 Declare Function FindWindow% Lib "user32" Alias "FindWindowA" _
                                          (ByVal lpClassName As Any, _
                                           ByVal lpCaption As Any)
                                           
 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

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

'●上記関数の呼び出しの使用例のコード
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 Long
    Dim myWindowPlacement As WINDOWPLACEMENT


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

    'ウィンドウハンドルの取得
    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



'###################################################################
'開いた何らかのアプリケーションをリサイズする関数。
'タスク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 Long
    Dim myWindowPlacement As WINDOWPLACEMENT


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

    'ウィンドウハンドルの取得
    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 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

Option Compare Database

Option Explicit

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

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

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

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 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

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

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

(ByVal lpClassName As Any, _

ByVal lpCaption As Any)

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

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

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

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 Long

Dim myWindowPlacement As WINDOWPLACEMENT

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

AppActivate active_title_name, False

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

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

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

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

'タスク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 Long

Dim myWindowPlacement As WINDOWPLACEMENT

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

AppActivate p_id, False

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

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 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

★ サブフォームの大きさを、「ガワ（親）」のAccessのアプリケーションウィンドウの大きさの変化に合わせて、フィットさせるコードは以下の通りです。
フォームの「リサイズ」のイベントに書きます。

以下のコードをサブフォームを持つフォームに書きます。
「Private Sub Form_Resize()」と「End Sub」は抜いて、中身だけをコピペすればOKかと思います。

フィットさせること自体にはWin32APIは必要ないのですが、最小化するときなどにエラー回避などで必要になります。（「frm_size_State01()関数による状態チェックで。）

'
'
Private Sub Form_Resize()

    '最小化すると何故かCPUの使用率が100%になってしまうのでそれを回避
    '（Win32API使用）
    
    If frm_size_State01(Me.hWnd) = "最小" Then
        Exit Sub
    ElseIf frm_size_State01(Me.hWnd) = "不明" Then
        Exit Sub
    ElseIf frm_size_State01(Me.hWnd) = "取得エラー" Then
        Exit Sub
    Else

    End If

    '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
    'これ以降のプログラムは、実際に、サブフォームの大きさを
    'フィットさせる処理ですが、本当はWin32APIなしでもOKです。
    'ウィンドウを最小化する事がないないなら、
    'Win32API（これより上のプログラム）は要りません。
    '（ここでは最小化することを前提としているので、
    '　　上記のWin32APIのコードも追記してあります。）
    'また、あまりウィンドウを小さくするとサブフォームの大きさがゼロよりも
    '小さくなってしまうのか、よくわかりませんが、エラーになります。
    'そのときのエラー処理は書いてませんので、ご自分で書いてみてください。
    'エラーになったらExit　Subでプログラムを終了させればOKかと思います。


    '●フォームの詳細セクションの大きさの調整
    '（フォームヘッダやフォームフッタの大きさは変わりません。
    
    Me.Width = Me.InsideWidth
    '詳細セクションには幅のプロパティが無いのでMe.（フォーム）で幅を調整
    'このコードはなくてもエラーにならないかもです。
    
    Me.詳細.Height = Me.InsideHeight - Me.フォームヘッダー.Height - Me.フォームフッター.Height - 800
    '最後のマイナスの数値の1000(twip)は、
    '「埋め込みとしてのガワ01」のHeightの数字と同じくらいか、
    '少し小さくするといいみたい。
    'あまり数字が大きくても小さくてもエラーになるっぽいです。
    '「= Me.InsideHeight - 」じゃなくて、「= Me.詳細.Height - 」でもいいかも。


    
    On Error Resume Next
    '最小化時にここでエラーになるので回避
    
    
    
    '●サブフォームの大きさの調整
    
    Me.埋め込みとしてのガワ01.Width = Me.InsideWidth - 500
    '最後のマイナスの数値が500よりも低すぎると、
    'サブフォームの右端の縦方向のスクロールバーが隠れてしまい、
    '切れた感じになるので注意。
    '数字はピクセルではなくて、twipです。
        
    Me.埋め込みとしてのガワ01.Height = Me.InsideHeight - Me.フォームヘッダー.Height - Me.フォームフッター.Height - 1000
    '最後のマイナスの数値を1000以下にすると、サブフォームの下側の
    '横方向のスクロールバーが下に隠れてしまう場合もあるので注意。
    '数字はピクセルではなくて、twipです。
    '「= Me.InsideHeight - 」じゃなくて、「= Me.埋め込みとしてのガワ01.Height - 」でもいいかも。

End Sub
'
'

Private Sub Form_Resize()

'最小化すると何故かCPUの使用率が100%になってしまうのでそれを回避

'（Win32API使用）

If frm_size_State01(Me.hWnd) = "最小" Then

Exit Sub

ElseIf frm_size_State01(Me.hWnd) = "不明" Then

Exit Sub

ElseIf frm_size_State01(Me.hWnd) = "取得エラー" Then

Exit Sub

Else

End If

'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

'これ以降のプログラムは、実際に、サブフォームの大きさを

'フィットさせる処理ですが、本当はWin32APIなしでもOKです。

'ウィンドウを最小化する事がないないなら、

'Win32API（これより上のプログラム）は要りません。

'（ここでは最小化することを前提としているので、

'　　上記のWin32APIのコードも追記してあります。）

'また、あまりウィンドウを小さくするとサブフォームの大きさがゼロよりも

'小さくなってしまうのか、よくわかりませんが、エラーになります。

'そのときのエラー処理は書いてませんので、ご自分で書いてみてください。

'エラーになったらExit　Subでプログラムを終了させればOKかと思います。

'●フォームの詳細セクションの大きさの調整

'（フォームヘッダやフォームフッタの大きさは変わりません。

Me.Width = Me.InsideWidth

'詳細セクションには幅のプロパティが無いのでMe.（フォーム）で幅を調整

'このコードはなくてもエラーにならないかもです。

Me.詳細.Height = Me.InsideHeight - Me.フォームヘッダー.Height - Me.フォームフッター.Height - 800

'最後のマイナスの数値の1000(twip)は、

'「埋め込みとしてのガワ01」のHeightの数字と同じくらいか、

'少し小さくするといいみたい。

'あまり数字が大きくても小さくてもエラーになるっぽいです。

'「= Me.InsideHeight - 」じゃなくて、「= Me.詳細.Height - 」でもいいかも。

On Error Resume Next

'最小化時にここでエラーになるので回避

'●サブフォームの大きさの調整

Me.埋め込みとしてのガワ01.Width = Me.InsideWidth - 500

'最後のマイナスの数値が500よりも低すぎると、

'サブフォームの右端の縦方向のスクロールバーが隠れてしまい、

'切れた感じになるので注意。

'数字はピクセルではなくて、twipです。

Me.埋め込みとしてのガワ01.Height = Me.InsideHeight - Me.フォームヘッダー.Height - Me.フォームフッター.Height - 1000

'最後のマイナスの数値を1000以下にすると、サブフォームの下側の

'横方向のスクロールバーが下に隠れてしまう場合もあるので注意。

'数字はピクセルではなくて、twipです。

'「= Me.InsideHeight - 」じゃなくて、「= Me.埋め込みとしてのガワ01.Height - 」でもいいかも。

End Sub

　　
以下、参考。
　　

★以下、64bitのExcelやAccess用の簡単な事例
（最前面にする機能などはなし。ガワのウィンドウサイズの変更のみ。）

MOUGのサンプルを64bit用にしただけのものです。
Excelファイルを開いたときに、Auto_Openプロシージャにより、
ガワのサイズを「1000×640」に自動変更しています。

64bitのAccessやWordなどでも動くと思います。

64bitのAccessでは、AutoExecマクロに「プロシージャの実行」で自動実行させたら
ちゃんと動きました。

'
'
Option Explicit

Private Declare PtrSafe Function GetForegroundWindow _
    Lib "user32" () As Long
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type WINDOWPLACEMENT
    Length As Long
    flags As Long
    showCmd As Long
    ptMinPosition As POINTAPI
    ptMaxPosition As POINTAPI
    rcNormalPosition As RECT
End Type
Private Declare PtrSafe Function GetWindowPlacement _
    Lib "user32" _
    (ByVal hwnd As Long _
    , lpwndpl As WINDOWPLACEMENT) As Long
Private Declare PtrSafe Function SetWindowPlacement _
    Lib "user32" _
    (ByVal hwnd As Long _
    , lpwndpl As WINDOWPLACEMENT) As Long


'Sub auto_open()
'    Call Sample
'End Sub


Sub auto_open()

    Call Sample

End Sub

'起動したアプリケーションの表示位置､サイズを指定する
Sub Sample()
    Dim myHwnd As Long
    Dim myWindowPlacement As WINDOWPLACEMENT
    'メモ帳を起動してアクティブにする
'    Call Shell("notepad", vbNormalFocus)
    'ウィンドウハンドルの取得
    myHwnd = GetForegroundWindow()
    'ウィンドウ情報の取得
    GetWindowPlacement myHwnd, myWindowPlacement
    'ウィンドウ情報を変更して設定
'    Stop
    With myWindowPlacement.rcNormalPosition
        .Left = 10
        .Top = 10
        .Right = 1000
        .Bottom = 640
    End With
    SetWindowPlacement myHwnd, myWindowPlacement
End Sub

'
'

Option Explicit

Private Declare PtrSafe Function GetForegroundWindow _

Lib "user32" () As Long

Private Type POINTAPI

x As Long

y As Long

End Type

Private Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Private Type WINDOWPLACEMENT

Length As Long

flags As Long

showCmd As Long

ptMinPosition As POINTAPI

ptMaxPosition As POINTAPI

rcNormalPosition As RECT

End Type

Private Declare PtrSafe Function GetWindowPlacement _

Lib "user32" _

(ByVal hwnd As Long _

, lpwndpl As WINDOWPLACEMENT) As Long

Private Declare PtrSafe Function SetWindowPlacement _

Lib "user32" _

(ByVal hwnd As Long _

, lpwndpl As WINDOWPLACEMENT) As Long

'Sub auto_open()

' Call Sample

'End Sub

Sub auto_open()

Call Sample

End Sub

'起動したアプリケーションの表示位置､サイズを指定する

Sub Sample()

Dim myHwnd As Long

Dim myWindowPlacement As WINDOWPLACEMENT

'メモ帳を起動してアクティブにする

' Call Shell("notepad", vbNormalFocus)

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

myHwnd = GetForegroundWindow()

'ウィンドウ情報の取得

GetWindowPlacement myHwnd, myWindowPlacement

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

' Stop

With myWindowPlacement.rcNormalPosition

.Left = 10

.Top = 10

.Right = 1000

.Bottom = 640

End With

SetWindowPlacement myHwnd, myWindowPlacement

End Sub

★ 以下、最初のAccessMDBファイルの32bit用のコードの、64bit版。
（最前面に固定する機能もあり。ガワのウィンドウサイズの変更ももちろんあり。通常はAPIのウィンドウ操作は最前面固定もよく求められるので、基本、こちらを使います。）

32bit用のDeclare文の「Function」の前に、「PtrSafe 」を付けるコード
　　　↓
Public Declare PtrSafe Function GetForegroundWindow Lib "user32" () As Long

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

Declare PtrSafe Function FindWindow% Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As Any, _
ByVal lpCaption As Any)
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
　　

「hWnd 」や「hWndInsertAfter 」などのポインタ系の値のデータ型を「Long」から「LongPtr」に変更するコード
（LongPtrは64bitならLongLong、32bitならLongに自動変換してくれるデータ型だそうです。64bitしか絶対に使わないなら、LongPtrをLongLongにしてもOK。逆に、「32bitAccessでも使うかも？と心配なら、LongPtrのほうがいいそうです。）
　　　↓
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

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

'
'

Option Compare Database
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)
                                           
 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

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

'●上記関数の呼び出しの使用例のコード
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 Long
    Dim myWindowPlacement As WINDOWPLACEMENT


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

    'ウィンドウハンドルの取得
    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



'###################################################################
'開いた何らかのアプリケーションをリサイズする関数。
'タスク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 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 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

Option Compare Database

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)

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

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

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

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 Long

Dim myWindowPlacement As WINDOWPLACEMENT

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

' AppActivate active_title_name, False

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

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

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

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

'タスク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 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 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

投稿タグ: Ac2000-Win32API

MENU

関連記事

最近の投稿

カテゴリー

MENU

Access2000Tips Win32 API サブフォームの大きさをAccessウィンドウの大きさの変化に伴いフィットさせたり、ウィンドウのサイズ自体を変更したり、最前面を固定化したり、のサンプルダウンロード

関連記事

最近の投稿

カテゴリー

タグ