今回は、Excel VBAで任意のフォルダから画像を取得してエクセルに貼り付ける方法の、一例をご紹介します。
※本ページはプロモーションが含まれています
スポンサーリンクスポンサーリンク任意のフォルダから画像を取得してエクセルに貼り付ける今回は、下記のサンプル１を元にご紹介します。
・サンプル１
Sub 画像貼り付け()Dim WID As LongDim HIGH As LongDim PAR As DoubleDim shp As ShapeDim ImageUrl As StringDim ImageName As StringDim FolderName As StringDim FilePath As StringDim 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 WithEnd IfEnd 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より大きい場合の条件分岐で、画像の高さではく幅を軸にしてレイアウトを調整していまして、基本的な流れは先ほどのものと同様になります。