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

マクロで帳票を作成するときに、データと一緒に画像も貼り付けたいという要望はあると思います。

本記事では、Excel で画像を貼り付けるマクロを作成しました。具体的には、画像をそのまま貼り付けるだけのマクロと、範囲が指定されたときに幅や高さを合わせるマクロを作成しています。

Excel VBA: 画像の大きさを変えずに指定の場所に貼り付けるマクロ

マクロを作るためには画像が必要ですが、貼り付ける画像がないという方は、いらすとやさんの画像を以下からダウンロードしてください!

参考 意識の低い人のイラスト(男性)いらすとや
保存パス

以下のソースでは画像をここ↓に保存している前提です!

“C:\Users\Public\Documents\ishiki_hikui_man.png”

VBAのソースコードを書く

ソースコードを書いていきましょう。処理内容はソースのコメントに書いてあります。

なおこのソースは以下のサイトを参考にさせてもらってます。

参考 画像ファイルを挿入するmougモーグ

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

ソースコードの解説

画像をExcelの指定の場所に貼り付ける

画像を貼り付ける位置を設定しているのは、Shapes.AddPictureメソッドのLeftとTopパラメーターです。

名前データ型説明
LeftSingle文書の左上隅を基準にして図の左上隅の位置をポイント単位で指定します。
TopSingle文書の左上隅を基準にして図の左上隅の位置をポイント単位で指定します。

上のソースコードでは、LeftとTopパラメーターをB2セルのLeftとTopに設定しているので、ExcelのB2セルに合わせて画像が貼り付けられます。

そのため、画像を貼り付ける場所を変更したい場合には、Set targetRange = Range(“B2”) のB2を変更してください。

参考 Shapes. AddPicture メソッド (Excel)Microsoft Docs

画像をそのままの大きさで貼り付ける

ShapesオブジェクトのScaleWidthとScaleHeightメソッドを使用します。Factor = 1、RelativeToOriginalSize = msoTrueに設定することで、図をそのままの大きさで貼り付けられます。

名前データ型説明
FactorSingle現在の高さと変更後の高さの比率、または元の高さと変更後の高さの比率を指定します。 たとえば、四角形を 50% 拡大する場合は、この引数に 1.5 を指定します。
RelativeToOriginalSizeMsoTriState元のサイズを基準にして図形を拡大または縮小する場合は msoTrue 。 現在のサイズを基準にして拡大または縮小する場合は msoFalse を指定します。 msoTrue を指定できるのは、図形が図または OLE オブジェクトのときだけです。
参考 ScaleWidth メソッド (Excel)Microsoft Docs

マクロを実行する

キーボードの【F5】を押す、または画面上部の【▶】を押して、マクロを実行します。

ExcelのB2セルの左上に合わせてに画像が表示されていれば完了です!

Excel VBA: 画像の大きさを指定範囲に合わせながら貼り付けるマクロ

ただ、マクロで画像を貼り付けたいという場合には、貼り付ける範囲が決まっていることもあるでしょう。

僕が経験した仕事には、毎回大きさが異なる画像を、指定した範囲(例えばB2:F13)に貼り付けるようなものがありました。イメージを以下にしめすと、「左の図の大きさを良い感じに枠の中に納まるようにして、右の図のようにしたい」という感じです。

以下では、そのときに対応した方法を紹介します。

仕様の説明

まずは、画像を貼り付ける仕様の説明をします。

  • 画像は縮小しますが、拡大はしません
  • 指定範囲よりも画像の縦横両方が小さい場合には、指定範囲の中央に画像を貼り付けます(①)
  • 指定範囲よりも画像の縦の方が大きい場合には、縦方向を指定範囲と同じ大きさにして、横方向の中心に画像を貼り付けます(②)
  • 指定範囲よりも画像の横の方が大きい場合には、横方向を指定範囲と同じ大きさにして、縦方向の中心に画像を貼り付けます(③)

①~③を図に示すと、以下のようになります。

VBAのソースコードを書く

ソースコードは以下になります。

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

 

ごりごりと処理を書いているので、あまり説明できる部分はないのですが、このソースのポイントとしては、Shape.LockAspectRatioプロパティをTrueにしています箇所です。

Shape.LockAspectRatioとは、図の縦横比を一定にするプロパティです。これを設定することで、画像がゆがまないようになっています。

参考 Shape.LockAspectRatio プロパティ (Excel)Microsoft Docs

マクロを実行する

キーボードの【F5】を押す、または画面上部の【▶】を押して、マクロを実行します。

仕様の説明の①のように画像が貼り付けられれば成功です!

なお罫線(黒い線)は、分かりやすいように筆者は手動で書きました。自動的に書かれないのでご注意ください。

ここまで完成したら、ソースコード内の範囲を指定する箇所を変更して、きちんと仕様通りに動くか確認してみるといいでしょう。

メモ

範囲をしていしているのは、ソースコード内の以下の部分になります。H22をF10にしたり、E20に変更すれば仕様の動きを確認できます。

Set targetRange = Range(“B2:H22”)