項目

　解像度によってコントロールサイズを変更する

概要

　解像度によってコントロールの位置、サイズ、フォントサイズを変更します。
　適当にフォームにコントロールを配置して試してみてください。
　VGA、SVGA、XGA、SXGA、SXGA+サイズにしか対応していません。
　1152×864等のサイズに対応するには、任意に書き換えてください。

方法

'--------------------------------------------
'フォームのオープンイベントにて関数を呼出
'--------------------------------------------
Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
    
    'コントロールサイズの変更
    ControlSiezeChange Me

End Sub

'--------------------------------------------
'標準モジュール
'--------------------------------------------
Option Compare Database
Option Explicit

'さまざまな表示要素の幅と高さとシステムの現在の構成を取得します｡
Public Declare Function GetSystemMetrics Lib "user32" _
                        (ByVal nIndex As Long) As Long

Public Const SM_CXSCREEN As Long = 0 'プライマリモニタの画面全体の幅
Public Const SM_CYSCREEN As Long = 1 'プライマリモニタの画面全体の高さ

'VGA
Public Const SCREEN_VGA_W = 640
Public Const SCREEN_VGA_H = 480

'SVGA
Public Const SCREEN_SVGA_W = 800
Public Const SCREEN_SVGA_H = 600

'XGA
Public Const SCREEN_XGA_W = 1024
Public Const SCREEN_XGA_H = 768

'SXGA
Public Const SCREEN_SXGA_W = 1280
Public Const SCREEN_SXGA_H = 1024

'SXGA+
Public Const SCREEN_SXGAPLUS_W = 1400
Public Const SCREEN_SXGAPLUS_H = 1050

'フォームを作成した時の解像度（ここを自分の環境に変更してください）
Public Const SCREEN_BASE_W = 1024
Public Const SCREEN_BASE_H = 768

'--------------------------------------------
'コントロールサイズの変更
'引数　：　frm  サイズを変更するフォーム
'--------------------------------------------
Public Sub ControlSiezeChange(frm As Form)

    Dim ctl 	As Control
    Dim kiesu   As Double

    '係数取得
    kiesu = GetKiesu

    'コントロールの数だけ実行
    For Each ctl In frm.Controls

        '位置、サイズ変更
        With ctl
            .Top = ctl.Top * kiesu
            .Left = ctl.Left * kiesu
            .Height = ctl.Height * kiesu
            .Width = ctl.Width * kiesu
        End With

        'フォントサイズ変更
        Select Case ctl.ControlType
            'ラベル、テキスト、コマンドボタン、コンボボックス、リストボックス
            Case acLabel, acTextBox, acCommandButton, acComboBox, acListBox
                ctl.FontSize = ctl.FontSize * kiesu
        End Select
        
    Next ctl
    
End Sub

'--------------------------------------------
'係数を求める
'--------------------------------------------
Public Function GetKiesu() As Double
    
    Dim w As Long
    Dim h As Long

    w = GetSystemMetrics(SM_CXSCREEN) '画面の幅
    h = GetSystemMetrics(SM_CYSCREEN) '画面の高

    '係数を求める
    Select Case w
    Case SCREEN_VGA_W           'VGA
        GetKiesu = SCREEN_VGA_W / SCREEN_BASE_W
    Case SCREEN_SVGA_W          'SVGA
        GetKiesu = SCREEN_SVGA_W / SCREEN_BASE_W
    Case SCREEN_XGA_W           'XGA
        GetKiesu = SCREEN_XGA_W / SCREEN_BASE_W
    Case SCREEN_SXGA_W          'SXGA
        GetKiesu = SCREEN_SXGA_W / SCREEN_BASE_W
    Case SCREEN_SXGAPLUS_W      'SXGA+
        GetKiesu = SCREEN_SXGAPLUS_W / SCREEN_BASE_W
    Case Else                   'その他の場合にはそのまま
        GetKiesu = 1
    End Select

End Function