VBA100本ノック 29本目：画像の挿入 - Infomentのブログ～Excel VBA奮闘記～

こちらで公開されている、100本ノックに挑戦。
www.excel-ubara.com
素晴らしい教材を公開いただき、ありがとうございます。

上記リンク先から、問題文を転載。

選択する方法は、先日も使用した「Application.FileDialog」を採用。
「選択できる拡張子は適当に」とのことだったので、今回は「*.jpg」とした。

Sub VBA_100Knock_029()
    ' 画像を挿入するセル。
    Dim TargetCell As Range
    Set TargetCell = ActiveCell
    ' 挿入する画像のファイルパス。
    Dim FilePath As String
        With Application.FileDialog(msoFileDialogFilePicker)
            ' ファイル選択ダイアログ表示。
            .Show
            ' ファイルの複数選択不可。
            .AllowMultiSelect = False
            ' ダイアログタイトル。
            .Title = "画像データ選択"
            ' 選択フィルタ。
            .Filters.Clear
            .Filters.Add "画像データ", "*.jpg"
            FilePath = .SelectedItems(1)
        End With
        
    ' 挿入する画像。
    Dim Drawing As Picture
    Set Drawing = ActiveSheet.Pictures.Insert(FilePath)
        ' 画像の縦横比を固定。
        Drawing.ShapeRange.LockAspectRatio = msoTrue
    
    ' 画像とセル、各々の縦横比を取得。
    ' どちらが「より縦長か？」を比較して、挿入する画像サイズをセルの
    ' 幅に合わせるか高さに合わせるか決定する。
    Dim AspectRatio(1) As Double
        AspectRatio(0) = TargetCell.Height / TargetCell.Width
        AspectRatio(1) = Drawing.Height / Drawing.Width
        
    ' セルの方が縦長なら、画像はセルの横幅に合わせる。
    If AspectRatio(0) >= AspectRatio(1) Then
        Drawing.ShapeRange.ScaleWidth TargetCell.Width / Drawing.Width, msoTrue
        ' 高さ方向の位置修正（セルの中央に配置）。
        ' 幅方向は、セルと同サイズのため調整不要。
        Drawing.Top = TargetCell.Top + (TargetCell.Height - Drawing.Height) / 2
    Else
        Drawing.ShapeRange.ScaleHeight TargetCell.Height / Drawing.Height, msoTrue
        ' 幅方向の位置修正（セルの中央に配置）。
        ' 鷹さ方向は、セルと同サイズのため調整不要。
        Drawing.Left = TargetCell.Left + (TargetCell.Width - Drawing.Width) / 2
    End If
End Sub