スキルアップ・問題解決なら、モーグにおまかせ！

エクセルファイルを開いたとき、上下２つのウィンドウを表示させることはできたが、
このとき、ウィンドウサイズを変更し、ウィンドウサイズを ３対１ に設定したい。
 
使用環境によって、ディスプレイのサイズが異なっても、ウィンドウサイズが ３対１ になるようにしたい。
 
あらかじめ ３対１ になるように設定して、保存しても、開いたとき、２つのウィンドウは維持されない。
VBAで ウィンドウサイズを設定したい。
 

その操作を「マクロの記録」で、コードを作成することはできますか？

WinArrow さんの引用:
その操作を「マクロの記録」で、コードを作成することはできますか？

>上記の数字が、どのような単位なのかわかりません
単位は、ポイントです。
 
スクリーンサイズは、ピクセルですから、
ピクセルをポイントに変換してみてください。
 
スクリーンサイズが異なる環境で運用するということなれば、
絶対値ではなくて、上下の割合で考えみては？

横合いからすみません。たたき台を示します。
カスタマイズはそちらで実行してください。
 

Option Explicit
'「画面解像度を取得する」
'即効テクニック 　　https://www.moug.net/tech/acvba/0020033.html
Private Declare Function GetSystemMetrics _
    Lib "user32" _
    (ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN As Long = 0
Private Const SM_CYSCREEN As Long = 1

Sub test()
    Dim myX As Long, myY As Long
    Dim my_width#, my_height#

    '画面の幅を取得     'pixel
    myX = GetSystemMetrics(SM_CXSCREEN)
    '画面の高さを取得   'pixel
    myY = GetSystemMetrics(SM_CYSCREEN)

    my_width = myX / 96 * 72        '単位 point
    my_height = myY / 96 * 72       '単位 point

    Dim cnt As Long, k As Long
    Dim w As Window
    
    'visivle windowをカウント
    For Each w In Windows
        If w.Visible Then cnt = cnt + 1
    Next
    
    ReDim wd(1 To cnt) As Window
    For Each w In Windows
        If w.Visible Then
            k = k + 1
            Set wd(k) = w
        End If
    Next
    
    'ひとつしかなければ、新規ウインドウを追加
    If cnt = 1 Then
        ReDim Preserve wd(1 To 2) As Window
        Set wd(2) = wd(1).NewWindow
    End If
    
    '上下に並べる
    ActiveWorkbook.Windows.Arrange ArrangeStyle:=xlHorizontal

    'Windowの大きさを調整
    With wd(1)
        .Left = 0
        .Top = 0
        .Width = my_width
        .Height = my_height * 3 / 4
    End With
    With wd(2)
        .Left = 0
        .Top = my_height * 3 / 4
        .Width = my_width
        .Height = my_height * 1 / 4
    End With
End Sub

 ThisWorkbook.Windows.Arrange xlArrangeStyleHorizontal してからHeightとTopを調整すると

 Sub sample()
    Dim win1 As Window, win2 As Window
    Set win1 = ThisWorkbook.Windows(1)
    If ThisWorkbook.Windows.Count < 2 Then ThisWorkbook.NewWindow
    Set win1 = ThisWorkbook.Windows(1)
    Set win2 = ThisWorkbook.Windows(2)
    For i = 3 To ThisWorkbook.Windows.Count
        ThisWorkbook.Windows(i).Close
    Next
    ThisWorkbook.Windows.Arrange xlArrangeStyleHorizontal
    Debug.Print win1.Top
    If win1.Top < win2.Top Then w = win1.Top: win1.Top = win2.Top: win2.Top = w
    win2.Height = win2.Height * 4 / 3
    win1.Top = win2.Height
    win1.Height = win1.Height * 2 / 3
 End Sub

WinArrow さん
simple さん
gombohoriさん
 
アドバイスありがとうございました。
 
具体的にコードまで添えていただき、感謝です。