命名って難しい

変数、関数、クラスなどなど実装より命名に毎回悩むタイプの人間による技術や趣味についてのメモ。

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