Excel VBA 画像オブジェクトの寄せ、範囲に入るようにリサイズ

作ったからメモ。 GitHubにあげた方がいいのかなと思いつつ、Gitに余り触れていないので メモ程度の記事にします。 コーディング規約ぐちゃぐちゃです。 VBAはどんな規約がメジャーなんでしょう・・・。

水平・垂直の寄せ

'* @brief シェイプの水平位置
Public Enum ShapeHorizontalAlign
    '* 左
    Left
    '* 中央
    Center
    '* 右
    Right
End Enum

'* @brief シェイプの垂直位置
Public Enum ShapeVerticalAlign
    '* 左
    Top
    '* 中央
    Center
    '* 右
    Bottom
End Enum

'* @brief 画像オブジェクトを対象の範囲で中央寄せにする。
'* @param oPicture 中央寄せにする画像オブジェクト
'* @param oRange 対象の範囲
Public Sub SetPictureAlignCenterInRange(oPicture As Shape, oRange As Range, hAlign As ShapeHorizontalAlign, vAlign As ShapeVerticalAlign)

    If hAlign = ShapeHorizontalAlign.Left Then
        oPicture.Left = oRange.Left
    ElseIf hAlign = ShapeHorizontalAlign.Center Then
        oPicture.Left = oPicture.Left + (oRange.Width - oPicture.Width) * 0.5
    ElseIf hAlign = ShapeHorizontalAlign.Right Then
        oPicture.Left = oPicture.Left + (oRange.Width - oPicture.Width)
    End If
    
    If vAlign = ShapeVerticalAlign.Top Then
        oPicture.Top = oPicture.Top
    ElseIf vAlign = ShapeVerticalAlign.Center Then
        oPicture.Top = oPicture.Top + (oRange.Height - oPicture.Height) * 0.5
    ElseIf vAlign = ShapeVerticalAlign.Bottom Then
        oPicture.Top = oPicture.Top + (oRange.Height - oPicture.Height)
    End If
    
End Sub

範囲に入るようにリサイズ

'* @brief 縦横比を考慮し、画像を対象の範囲に収まるようにリサイズする
'* @param oPicture リサイズ対象の画像オブジェクト
'* @param oRange   画像オブジェクトを当てはめる範囲
Public Sub ResizeShapeToFitInsideRange(oPicture As Shape, oRange As Range)

    ' 原寸大に設定
    oPicture.ScaleHeight 1!, msoTrue
    oPicture.ScaleWidth 1!, msoTrue
    
    ' 縦長、横長で合わせる行を変える。
    Dim ratio As Single
    Dim hRatio As Single
    Dim wRatio As Single
    
    wRatio = CSng(oRange.Width / oPicture.Width)
    hRatio = CSng(oRange.Height / oPicture.Height)
    
    ratio = Application.WorksheetFunction.Min(hRatio, wRatio)
    
    ' 倍率でリサイズ
    oPicture.ScaleHeight ratio, msoTrue
    oPicture.ScaleWidth ratio, msoTrue

End Sub