VBA 画像のセル内中央挿入

Question

画像挿入を 指定セル内＆中央揃え にしたいです。

こちらのコードでセル内の左揃えになります。
こちらを中央揃えにするにはどうすればよいのでしょう。
教えていただけたら幸いです。よろしくお願いいたします。

    Dim shape As shape
    shape.ScaleHeight 1, msoTrue
    shape.ScaleWidth 1, msoTrue
    shape.LockAspectRatio = msoTrue
    shape.Height = ActiveCell.Height - 5
    
    Set shape = Nothing
End Sub

Answer 1

こんにちは。
画像の比率によってセルをはみ出るケースがあると思います。その場合の中央寄せはどのように考えていますか。
以下に、選択したセルに収まるよう画像調整し、TopもLeftもセル中央寄せにする例を挙げますので改造してください。

Sub hoge()
    '画像読み込み
    Dim shape As shape
    Set shape = ActiveSheet.Shapes.AddPicture( _
        Filename:="C:\temp\hoge.jpg", _
        LinkToFile:=False, _
        SaveWithDocument:=True, _
        Left:=0, _
        Top:=0, _
        Width:=0, _
        Height:=0)
    shape.ScaleHeight 1, msoTrue
    shape.ScaleWidth 1, msoTrue
    shape.LockAspectRatio = msoTrue

    '選択セル内に中央揃え
    Dim margin As Integer
    margin = 10
    With shape
        .Left = ActiveCell.Left
        .Top = ActiveCell.Top
        'セル内に画像サイズ調整
        .Height = ActiveCell.Height - margin
        If .Width > ActiveCell.Width Then
            .Width = ActiveCell.Width - margin
        End If
        '横を中央寄せ
        .Left = .Left + (ActiveCell.Width - shape.Width) / 2
        '縦を中央寄せ
        .Top = .Top + (ActiveCell.Height - shape.Height) / 2
    End With
    
    Set shape = Nothing
End Sub

ご希望の動作を実現する仕組みがVBAに用意されているのか存じませんので、単純に位置調整しただけです。万が一、プロパティやメソッド一発で出来たらすみません。