縦横の割合を指定してユーザーフォームのサイズを変更する(メモ)

ユーザーフォームのサイズを変更する時、Zoomを使うと拡大・縮小できるが縦横の比率が固定される
別々に指定して変更したかったのでメモ

'画面サイズをExcelの画面サイズからの割合で変更する
'myForm:変更対象のフォーム
'HeightRate:高さの割合
'WidthRate:幅の割合
Public Sub ReSize(myForm As Object, HeightRate As Integer, WidthRate As Integer)

Dim Control As Variant
Dim ZoomHeight As Double
Dim ZoomWidth As Double
Dim bH As Integer
Dim bW As Integer

    '元の高さと幅
    bH = myForm.Height
    bW = myForm.Width

    '高さと幅を割合で変更
    myForm.Height = Application.Height * (HeightRate / 100)
    myForm.Width = Application.Width * (WidthRate / 100)

    '元のサイズとの比率
    ZoomHeight = myForm.Height / bH
    ZoomWidth = myForm.Width / bW

    '位置を中央に移動
    myForm.Top = (Application.Height - myForm.Height) / 2
    myForm.Left = (Application.Width - myForm.Width) / 2

    '各コントロールの位置とサイズを比率から修正
    For Each Control In myForm.Controls
        Control.Height = Control.Height * ZoomHeight
        Control.Width = Control.Width * ZoomWidth
        Control.Top = Control.Top * ZoomHeight
        Control.Left = Control.Left * ZoomWidth
    Next

End Sub

基準サイズはApplication.Height,Application.Widthで取得している為、Excelウィンドウのサイズとなる
ディスプレイ基準にする時はAPIなどで取得すること