Office TANAKA - Excel VBA Tips[画像を挿入する]

ワークシート上に画像を挿入するには、次のようにします。

Sub Macro1()
    ActiveSheet.Pictures.Insert "C:\Work\Sample1.jpg"
End Sub

画像を、アクティブシートに挿入するときは、必ずアクティブセルに挿入されます。正確に言うと、アクティブセルの左上に画像の左上がくるように挿入されます。

次のように、シートを指定すれば、アクティブシートではない(表示されていない)シートに画像を挿入することもできます。

Sub Macro2()
    Sheets("Sheet1").Pictures.Insert "C:\Work\Sample1.jpg"
End Sub

このように、挿入するシートがアクティブシートではなかった場合、画像は常にセルA1に挿入されます。そりゃそうですね。だって、アクティブシートではないシートに、アクティブセルはありませんから。

指定した位置に画像を挿入する

上述のように、挿入される画像は、基本的に「アクティブセルを左上」とした位置に挿入されます。もし、任意のセルに画像を挿入するのなら、まず挿入したい位置にアクティブセルを移動して・・・なんてことはしません。発想を変えます。挿入した画像を、指定した位置に移動すればいいんです。ちなみに、挿入した画像を、手動で移動する操作をマクロ記録すると、次のようなコードが記録されます。

Sub Macro3()
    ActiveSheet.Shapes.Range(Array("Picture 1")).Select
    Selection.ShapeRange.IncrementLeft 74.25
    Selection.ShapeRange.IncrementTop 35.25
End Sub

ほとんどの人は、このコードを見て絶句するでしょう。「なんじゃ、これは・・・」って。1行目からツッコミどころ満載です。しかも、移動に関するコードには、74.25とか訳の分からない数値が出てくるし。よしんば、このコードを理解したところで、これを応用して"指定したセルに画像を移動する"なんてのは、相当に難しいです。

簡単です。画像を表すPictureオブジェクトには、その左位置を表すLeftプロパティと、上位置を表すTopプロパティが用意されています。それを指定すればいいんです。次のコードは、すでに挿入されている画像を、セルB3の位置に移動します。

Sub Macro4()
    ActiveSheet.Pictures("Picture 1").Top = Range("B3").Top
    ActiveSheet.Pictures("Picture 1").Left = Range("B3").Left
End Sub

もし、挿入している画像が1枚しかないのでしたら、次のようにインデックスで指定した方が簡単です。

Sub Macro5()
    ActiveSheet.Pictures(1).Top = Range("B3").Top
    ActiveSheet.Pictures(1).Left = Range("B3").Left
End Sub

なんか、同じようなコードが2行並んで美しくないですから、Withでくくりましょうか。

Sub Macro6()
    With ActiveSheet.Pictures(1)
        .Top = Range("B3").Top
        .Left = Range("B3").Left
    End With
End Sub

挿入すると同時に、指定した位置に移動するのでしたら、次のようにします。

Sub Macro7()
    With ActiveSheet.Pictures.Insert("C:\Work\Sample1.jpg")
        .Top = Range("B3").Top
        .Left = Range("B3").Left
    End With
End Sub

Insertの後ろに括弧を付けました。意味が分からない人は「括弧はどんなときに使うの？」をご覧ください。

挿入する画像ファイルを、毎回ユーザーに指定させるには、たとえば次のような感じですかね。

Sub Macro8()
    Dim A As String
    A = Application.GetOpenFilename("画像,*.jpg", , "画像ファイルの選択")
    If A = "False" Then Exit Sub
    With ActiveSheet.Pictures.Insert(A)
        .Top = Range("B3").Top
        .Left = Range("B3").Left
    End With
End Sub

画像の大きさを指定する

画像の横幅や高さは、WidthプロパティやHeightプロパティを使います。ここでも、数値で指定するというよりも、セルを基準にするのが簡単です。次のコードは、挿入した画像の横幅をセル範囲B3:C3に合わせます。

Sub Macro9()
    With ActiveSheet.Pictures.Insert("C:\Work\Sample1.jpg")
        .Top = Range("B3").Top
        .Left = Range("B3").Left
        .Width = Range("B3:C3").Width
    End With
End Sub

高さもやってみましょう。

Sub Macro10()
    With ActiveSheet.Pictures.Insert("C:\Work\Sample1.jpg")
        .Top = Range("B3").Top
        .Left = Range("B3").Left
        .Height = Range("B3:B12").Height
    End With
End Sub

上記の結果を見て、気づきましたか？画像の横幅(Width)や高さ(Height)を指定しても、元画像の"縦横比"は変わりません。じゃ、両方指定したらどうなるんでしょう？

Sub Macro11()
    With ActiveSheet.Pictures.Insert("C:\Work\Sample1.jpg")
        .Top = Range("B3").Top
        .Left = Range("B3").Left
        .Width = Range("B3:C3").Width
        .Height = Range("B3:B12").Height
    End With
End Sub

後から指定した方が優先されます。いずれにしても、元画像の"縦横比"は維持したままです。これを強引に、縦横比を無視して、指定した大きさにしたいときは、LockAspectRatioプロパティにmsoFalseを指定します。標準では、縦横比が維持されますので、LockAspectRatioプロパティはmsoTrueです。ちなみに、msoFalseやmsoTrueの実体は、FalseやTrueと同じですから、Falseを指定しても同じ結果になります。

Sub Macro12()
    With ActiveSheet.Pictures.Insert("C:\Work\Sample1.jpg")
        .Top = Range("B3").Top
        .Left = Range("B3").Left
        .LockAspectRatio = msoFalse
        .Width = Range("B3:C3").Width
        .Height = Range("B3:B12").Height
    End With
End Sub

考え方は正しいのですが、これ実行するとエラーになります。

LockAspectRatioプロパティは、Pictureオブジェクトではなく、Shapeオブジェクトのプロパティだからです。

いや、実を言うと、今のVBAにはPictureオブジェクトがありません。ちょっと記憶が不確かなのですが、確かPictureオブジェクトって、Excel 95までの仕組みだったはず。それが、VBAのバージョンが上がったExcel 97から「新しくShapeオブジェクト作ったから、これからはShapeオブジェクト使ってね～」みたくなったはずです。ただ、いきなり従来のPictureオブジェクトを使えなくしたら、それまでのマクロが動作しなくなりますから、下位互換性を保つために、いわば"裏ルート"として残してあると。そんな状況ではなかったかと。いや、いかんせん、かれこれ四半世紀近くも前の話ですからw さすがに正確なところは覚えていません。私の事務所には、Excel 95もありますから、そのうち確認してみます。

いずれにしても、LockAspectRatioプロパティはShapeオブジェトのプロパティです。ですから、次のようにしなければなりません。

Sub Macro13()
    With ActiveSheet.Pictures.Insert("C:\Work\Sample1.jpg")
        .Top = Range("B3").Top
        .Left = Range("B3").Left
        ActiveSheet.Shapes(1).LockAspectRatio = msoFalse
        .Width = Range("B3:C3").Width
        .Height = Range("B3:B12").Height
    End With
End Sub

もちろん上記のコードは、アクティブシート上に画像が1つしか挿入されていないという前提です。もし、複数の画像がすでに挿入されていて、そこに新しい画像を挿入するのでしたら、次のように工夫しなければなりませんね。

Sub Macro14()
    With ActiveSheet.Pictures.Insert("C:\Work\Sample1.jpg")
        .Top = Range("B3").Top
        .Left = Range("B3").Left
        With ActiveSheet.Shapes
            .Item(.Count).LockAspectRatio = msoFalse
        End With
        .Width = Range("B3:C3").Width
        .Height = Range("B3:B12").Height
    End With
End Sub

あるいは、名前で特定するのでしたら、次のような感じでしょうか。

Sub Macro15()
    With ActiveSheet.Pictures.Insert("C:\Work\Sample1.jpg")
        .Top = Range("B3").Top
        .Left = Range("B3").Left
        ActiveSheet.Shapes(.Name).LockAspectRatio = msoFalse
        .Width = Range("B3:C3").Width
        .Height = Range("B3:B12").Height
    End With
End Sub

幸いなことに、挿入したPictureオブジェクトの名前(Nameプロパティ)と、指定するShapeオブジェクトの名前(Nameプロパティ)は、同じ文字列が設定されますので、その名前を流用しています。

ちなみに、今回写真でご登場いただいたのは、私の行きつけの店「地酒遊楽裏や」の店長です。いつも、お世話になっています。裏やは、あの野崎酒店の系列で、全国の美酒を常時160種類取り揃えた地酒専門居酒屋です。旬のお料理と絶品の日本酒をご用意して、皆様のご来店を心よりお待ちしております。池袋東口から徒歩5分。お近くにお越しの際には、ぜひお気軽にお立ち寄りください。