【Excel VBA】画像を貼り付けるマクロ（指定の範囲に幅や高さを合わせることも可能）

copy

Public Sub PastePicture1()

    Dim sheet As Worksheet
    Dim filePath As String
    Dim targetRange As Range
    Dim picture As Shape
    Dim targetRangeHeight, targetRangeWidth As Single
    
    ' シートを指定する
    Set sheet = ActiveSheet
    
    ' ファイルパス
    filePath = "C:\Users\Public\Documents\ishiki_hikui_man.png"
    
    ' 貼り付ける範囲を指定する
    Set targetRange = Range("B2")
    
    ' ExcelのB2セルに合わせて図を挿入する
    Set picture = sheet.Shapes.AddPicture( _
        fileName:=filePath, _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoTrue, _
        Left:=targetRange.Left, _
        Top:=targetRange.Top, _
        Width:=0, _
        Height:=0)
    
    ' 挿入した図を元の大きさにする
    With picture
        .ScaleHeight 1, msoTrue
        .ScaleWidth 1, msoTrue
    End With
    
End Sub

copy

Public Sub PastePicture2()

    Dim sheet As Worksheet
    Dim filePath As String
    Dim targetRange As Range
    Dim picture As Shape
    Dim targetRangeHeight, targetRangeWidth As Single
    
    ' シートを指定する
    Set sheet = ActiveSheet
    
    ' ファイルパス
    filePath = "C:\Users\Public\Documents\ishiki_hikui_man.png"
    
    ' 貼り付ける範囲を指定する
    Set targetRange = Range("B2:H22")
    targetRangeWidth = targetRange.Width
    targetRangeHeight = targetRange.Height
    
    ' 図を挿入する
    Set picture = sheet.Shapes.AddPicture( _
        fileName:=filePath, _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoTrue, _
        Left:=0, _
        Top:=0, _
        Width:=0, _
        Height:=0)
    
    ' 挿入した図を元の大きさにして、縦横比を固定する
    With picture
        .LockAspectRatio = msoTrue
        .ScaleHeight 1, msoTrue
        .ScaleWidth 1, msoTrue
    End With
    
    ' 画像の大きさを設定する
    With picture
        ' 指定範囲の左上に仮置きする
        .Left = targetRange.Left
        .Top = targetRange.Top

        ' 指定範囲よりも画像の縦横両方が小さい場合
        If .Width < targetRangeWidth And .Height < targetRangeHeight Then
            .Left = .Left + (targetRange.Width - .Width) / 2
            .Top = .Top + (targetRange.Height - .Height) / 2
        Else
            ' 画像の幅を指定範囲に仮設定する
            .Width = targetRangeWidth
            
            '
            If .Height > targetRangeHeight Then
                .Height = targetRangeHeight
                .Left = .Left + (targetRange.Width - .Width) / 2
            Else
                .Top = .Top + (targetRange.Height - .Height) / 2
            End If
            
        End If

    End With

End Sub