複数の画像をVBAでエクセルに貼り付ける方法

質問

VBA初心者です。

多数のJPG画像が指定のフォルダ内に保存してあります。
JPG画像には、img_001.jpg、img_002.jpg・・・というように連番の名前が記載されています。

EXCELファイルのA列のセルに入力されているランダムな数値に対応した画像が
同じ行のB列に表示するようにしたいと考えています。
（たとえば、A1のセルに1を入力したら、B1のセルにimg_001.jpgが表示される）

このような操作を、VBAを使用して作成することはできるのでしょうか。

回答No.3

kumano_SEC

すみません実行分の1行目をタイプミスしたようです

(誤) w_file = c:\pic\image.jpg '画像ファイル名(フルパス)

(正) w_file ="c:\pic\image.jpg" '画像ファイル名(フルパス)

回答No.2

kumano_SEC

以前したことがあります

sub test_Shape()

'現在のセル位置に指定画像を貼り付ける(セルの高さに合わせる場合)
'オブジェクトの宣言
Dim MyShape As Shape
Dim Pic As stdole.IPictureDisp
'ワーク変数の宣言
Dim w_file As string
Dim w_width As Long
Dim w_hight As Long
Dim w_ritu As Double

w_file = c:\pic\image.jpg '画像ファイル名(フルパス)

Set Pic = LoadPicture(w_file)

w_hight = Selection.Height 'セルの高さ
w_ritu = w_hight / Pic.Height '比率 = セルの高さ / 実画像の高さ
w_width = Int(Pic.Width * w_ritu)

Set MyShape = ActiveSheet.Shapes.AddPicture( _
Filename:=w_file, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Selection.Left, _
Top:=Selection.Top, _
Width:=w_width, _
Height:=w_hight)

end sub

これでいけるはず

回答No.1

keithin

シート名タブを右クリックしてコードの表示を選ぶ
現れたシートに下記をコピー貼り付ける

private sub Worksheet_Change(byval Target as range)
　dim h as range
　dim ha as range
　dim mypath as string
　set target = application.intersect(target, range("A:A"))
　if target is nothing then exit sub

　’指定のフォルダを指定する
　mypath = "c:\test\"

　on error resume next
　for each ha in target.areas
　　for each h in ha
　　if h <> "" then
　　with activesheet.pictures.insert(mypath & "img_" & format(h, "000") & ".jpg")
　　　.top = h.top
　　　.left = h.offset(0, 1).left
　　 '.width = ...option
　　 '.height = ...option
　　　.name = "IMG_" & h.address
　　end with

　　else
　　　activesheet.shapes("IMG_" & h.address).delete
　　end if
　　next
　next
end sub

Ａ列に数字を記入する。

＃後出しでついでに聞いちゃえ「あれもしたいこれもできますか」は無しの方向でお願いします。
　サンプルマクロを下敷きにご自分で検討してみて，どうにも手が出なかったらまたご質問の状況を明確にして別途ご相談を。