【Excel VBA】任意のフォルダから画像を取得してエクセルに貼り付ける

今回は、Excel VBAで任意のフォルダから画像を取得してエクセルに貼り付ける方法の、一例をご紹介します。

任意のフォルダから画像を取得してエクセルに貼り付ける

今回は、下記のサンプル１を元にご紹介します。

・サンプル１

Sub 画像貼り付け()

Dim WID As Long
Dim HIGH As Long
Dim PAR As Double
Dim shp As Shape
Dim ImageUrl As String
Dim ImageName As String
Dim FolderName As String
Dim FilePath As String
Dim DLValue As Long

FolderName = ThisWorkbook.Path & “\” & “image” ‘画像が保存されているフォルダを指定
ImageName = “テスト” ‘画像名を指定
FilePath = FolderName & “\” & ImageName & “.jpg” ‘画像のフルパスを指定

‘変数FilePathに代入したパスが存在しているか調べる、存在しない場合はなにも処理しない
If Dir(FilePath) = “” Then

Else

Cells(1, 1).Select ‘セルA1をアクティブセルに
Cells(1, 1).RowHeight = 135 ‘セルA1の高さ指定
Cells(1, 1).ColumnWidth = 40 ‘セルA1の幅指定

‘画像をシートに貼り付ける
Set shp = ActiveSheet.Shapes.AddPicture(fileName:=FilePath, LinkToFile:=False, SaveWithDocument:=True, _
Left:=Selection.Left, Top:=Selection.Top, WIDTH:=0, Height:=0)

With shp

‘画像をいったんオリジナルのサイズに戻す
.ScaleHeight 1, msoTrue
.ScaleWidth 1, msoTrue

‘画像の高さが、画像の幅×0.8以上の場合
If .Height >= .WIDTH * 0.8 Then

HIGH = Selection.Height ‘セルの高さを取得
PAR = HIGH / .Height ‘比率=セルの高さ / 画像の高さ
WID = Int(.WIDTH * PAR) ‘画像の幅=画像の幅を比率で縮小

.WIDTH = WID * 0.9 ‘貼り付ける画像の幅を指定
.Height = HIGH * 0.9 ‘貼り付ける画像の高さを指定

‘画像の位置を調整
.Left = .Left + 10
.Top = .Top + (ActiveCell.Height – .Height) / 2

‘画像の幅が、画像の高さ×0.8より大きい場合
ElseIf .WIDTH * 0.8 > .Height Then

WID = Selection.WIDTH ‘セルの幅を取得
PAR = WID / .WIDTH ‘比率=セルの幅 / 画像の幅
HIGH = Int(.Height * PAR) ‘画像の高さ=画像の高さを比率で縮小

.WIDTH = WID * 0.9 ‘貼り付ける画像の幅を指定
.Height = HIGH * 0.9 ‘貼り付ける画像の高さを指定

‘画像の位置を調整
.Left = .Left + 10
.Top = .Top + (ActiveCell.Height – .Height) / 2

End If

End With
End If
End Sub

上記のサンプル１についてですが、まず、変数FolderNameに画像が保存されているフォルダを指定を代入し、変数ImageNameには取得する画像名称を代入し、変数FilePathには画像のフルパス（拡張子付き）を指定します。

今回の例では、ThisWorkbook.Pathを使ってこのプログラムを作成しているエクセルファイルが存在するフォルダと同フォルダに、「image」というフォルダを作成し、取得する画像の名称は「テスト」で、拡張子は「.jpg」を指定しています。

If Dir(FilePath) = “” Then

で、変数FilePathに代入したパスが存在しているか調べ、存在しない場合はなにも処理しません。

パスが存在していた場合の処理ですが、

Cells(1, 1).Select

でセルA1をアクティブにし、

画像を貼り付けるだけのセルの幅と高さを確保するため、

Cells(1, 1).RowHeight = 135

でセルの高さを指定し、

Cells(1, 1).ColumnWidth = 40

でセルの幅を指定しています。
次の、

Set shp = ActiveSheet.Shapes.AddPicture(fileName:=FilePath, LinkToFile:=False, SaveWithDocument:=True, _
Left:=Selection.Left, Top:=Selection.Top, WIDTH:=0, Height:=0)

ですが、これは画像をシートに貼り付けるためのもので、

Filename

でシートに貼り付けたい画像ファイルを指定し、

LinkToFile

では、Trueで元画像とのリンクを設定し、Falseで独立した画像としてシートに貼り付けるかを指定できるのですが、今回はFalseとしています。

SaveWithDocument

では、Trueでエクセルファイルとともに画像を保存、Falseでは画像リンク情報だけを保存となるのですが、今回はTrueとしています。

Left

では、挿入する画像の左端位置を指定できるため、左端を指定し、
Top
では、挿入する画像の上端位置を指定できるため、最上部を指定します。

また、

Width

では画像の幅を指定、

Height
では画像の高さを指定できるのですが、これらは後に改めて指定するためどちらも0としています。

.ScaleHeight 1, msoTrue

.ScaleWidth 1, msoTrue

では画像をいったんオリジナルの画像サイズに戻しています。

If .Height >= .WIDTH * 0.8 Then

からは画像のサイズ調整となっているのですが、こちらは画像が縦長の場合や横長の場合などを調整した一例となりますので、好みや状況に応じてサイズ調整をしていただければと思います。

一応今回の例についてざっと流しますと、

If .Height >= .WIDTH * 0.8 Then

は、画像の高さが、画像の幅×0.8以上の場合の条件分岐で、

HIGH = Selection.Height

でセルの高さを取得、

PAR = HIGH / .Height

で、セルの高さと画像の高さの比率を取得、

WID = Int(.WIDTH * PAR)

で画像の幅を先ほど計算した比率で縮小しています。

.WIDTH = WID * 0.9
.Height = HIGH * 0.9

では少々画像サイズを微調整して、レイアウトにゆとりを持たせています。

.Left = .Left + 10
.Top = .Top + (ActiveCell.Height – .Height) / 2

最後に画像のセル内での位置を調整します。
ElseIf .WIDTH * 0.8 > .Height Then

からは画像の幅が、画像の高さ×0.8より大きい場合の条件分岐で、画像の高さではく幅を軸にしてレイアウトを調整していまして、基本的な流れは先ほどのものと同様になります。