★★Access2000VBA・Excel2000VBA独学～Win32API。起動したソフトのウィンドウの位置とサイズを変更する方法・Googl eChromeを例に。（Excel、Word、Access、などが32bit版のモノでしか使えませんが、OSは64bitでも大丈夫です。）～

★★Access2000VBA・Excel2000VBA独学～Win32API。起動したソフトのウィンドウの位置とサイズを変更する方法・Googl eChromeを例に。（Excel、Word、Access、などが32bit版のモノでしか使えませんが、OSは64bitでも大丈夫です。）～
　　
※まだ書きかけです。すみません。
※間違ってたらすみません。
※メモ書きなので、自分でも意味不明な箇所も多いです。ごめんなさい。
　　
目次

※Shift＋TABキー、もしくは、Homeキー、Homeキー＋TAB数回、を押すと、目次付近に戻れます。
　　
　　

「起動したソフトのウィンドウの位置とサイズを変更する方法」については、UWSCを使う方法があります。

それだと、例えば、
『 ACW(GETID("Microsoft Visual Basic for Applications","wndclass_desked_gsk"),10,10,1000,700,0) 』
という1行で、VBEが開いてさえいれば、VBEの画面を、
Top10ピクセル、
Left10ピクセル、の位置に、
ヨコ1000ピクセル
タテ700ピクセル、の大きさで、
サイズの自動調整をしてくれます。
「Microsoft Visual Basic for Applications」の部分を、ウィンドウのタイトルバーの文言の一部を指定します。

これは、VBAにて、そのUWSファイルをShell関数を使って開けば、それがそのままVBAでもやれます。

また、ショートカットアイコンでもできるそうです。
『Chromeを起動したときに表示されるウィンドウの位置と大きさを指定する方法』
引用：「 "C:\Program Files\Google\Chrome\Application\chrome.exe" --window-position=150,10 --window-size=1190,880 」
　　
　　
ただ、「どうしてもAPIでやりたい」というときは、以降に挙げたようなコードで可能です。

「GoogleChromeのウィンドウをリサイズする」ということでのサンプルです。

まず以降のコードをすべて丸ごと標準モジュールにコピペして、
・必ずGoogleChromeを開いてから
・一番最後の「AtherWinPosiSIzeChange01()」プロシージャを実行
してみます。

実際には、
・Shell関数か何かでGoogleChromeを起動してから、
・最初のページが表示されるまでDoEventか何かして、
・完了した後に、「AtherWinPosiSIzeChange01()」プロシージャを実行

みたいな感じになるかと思います。
（当方のテストでは、「最初のページが表示されるまで」待たなくても、Chromeの画面が表示された直後なら大丈夫でしたけど念のため・・・）

「AtherWinPosiSIzeChange01()」はウィンドウのタイトルバーの文言の一部でやっていますが、それでダメなら、「タスクID(プロセスID）からリサイズする。」のほうの関数（「app_window_risize_for_p_id()」）をCallしてみます。

「タスクID」は、Shell関数でアプリを起動した際の戻り値で良かったかも？です。

※繰り返しますが、64bit版のExcelでは動きません。すみません。

'
'
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    ' 位置を変更しない



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


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


'###################################################################
'「すでに開いている「Google」の文言がウィンドウタイトルに入った
'アプリケーションの画面の大きさと位置を、
'10－10－800×600に変更するサンプル
'
'###################################################################

Sub AtherWinPosiSIzeChange01()

    Dim AppName As String
    'ウィンドウタイトルの一部を格納する変数
    
    On Error GoTo error1:
    
    AppName = "chrome"
    'ウィンドウのタイトルバーの文言の一部を指定
    '「Google」にしたら、語句検索をしたあとだとダメだったので
    '「chrome」を指定。
    
    
    ' AppActivate AppName, False
     ' '念のため指定された他のソフトのウィンドウをアクティブにします。
    '
    
    'ウィンドウの位置とサイズを決める
    Call app_window_risize_for_title_name(AppName, _
                                          10, _
                                          10, _
                                          800, _
                                          600)
    
    'ウィンドウの調整をします。
    '("ウィンドウのタイトルバーの一部の文字列", 左位置, 上位置, 幅, 高さ)
    '数値はtwipではなくてピクセルです。
    
    'もちろん、そのウィドウが既に開いていることが前提です。
    
    '※タイトルバーの一部の文字列の指定でよいと思います。
    
    Exit Sub
    
     error1:
    
    If Err.Number = 5 Then
        '指定したソフトが開いていない場合は、エラー番号が5のエラーになるので
        '以下の処理をします。
        
        MsgBox "入力したソフトが起動していないかソフトの名前が違うようです。再度やり直してください。"
        Exit Sub
        
    Else
        'エラー番号が何であってもこわいので一応終わっておきます。
        Exit Sub
    End If


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

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

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 ' 位置を変更しない

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

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

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

'タイトル名は全部じゃなくても一部でも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

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

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

'「すでに開いている「Google」の文言がウィンドウタイトルに入った

'アプリケーションの画面の大きさと位置を、

'10－10－800×600に変更するサンプル

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

Sub AtherWinPosiSIzeChange01()

Dim AppName As String

'ウィンドウタイトルの一部を格納する変数

On Error GoTo error1:

AppName = "chrome"

'ウィンドウのタイトルバーの文言の一部を指定

'「Google」にしたら、語句検索をしたあとだとダメだったので

'「chrome」を指定。

' AppActivate AppName, False

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

'ウィンドウの位置とサイズを決める

Call app_window_risize_for_title_name(AppName, _

10, _

800, _

600)

'ウィンドウの調整をします。

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

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

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

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

Exit Sub

error1:

If Err.Number = 5 Then

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

'以下の処理をします。

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

Exit Sub

Else

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

Exit Sub

End If

End Sub

MENU

関連記事

最近の投稿

カテゴリー

MENU

★★Access2000VBA・Excel2000VBA独学～Win32API。起動したソフトのウィンドウの位置とサイズを変更する方法・Googl eChromeを例に。（Excel、Word、Access、などが32bit版のモノでしか使えませんが、OSは64bitでも大丈夫です。）～

関連記事

最近の投稿

カテゴリー

タグ