エクセルのマクロ

質問

エクセルに画像を貼りつけるマクロを教えてください。
エクセルにたくさんの数字が入っています。
その数字と同じファイル名の画像を貼りつけたいです。

数字は何度も同じものが出てくるので、エクセルのシートに入っている数字すべてに張り付けたいです。

よろしくお願いいたします。

回答No.2

Mathmi

画像がどのフォルダに入っているのか、画像名がシートのどのセルに入っているのか、画像名はどのような形で入っているのか(拡張子は付いているのか)、複数のシート・ブックに対して行いたいのか、不明な点が多いので、そのままずばりのコードは書けません。

一応、参考になるだろうコードを下に書いておきます。
ファイル名が入ったセル範囲やパス名、ファイル名等を適宜変更して下さい。

Sub PasteImage()
　Dim TargetPath As String
　Dim TargetRange As Range
　Dim myCell As Range
　Dim myShp As Shape

　TargetPath = "C:" '画像ファイルが入っているフォルダのパス。ThisWorkbook.Pathでもよいか？
　Set TargetRange = Selection '貼り付けたい画像名が入力されているセル範囲。

　On Error Resume Next '画像がない等エラーが出た時にスキップする。
　For Each myCell In TargetRange
　　Set myShp = ActiveSheet.Shapes.AddPicture(Filename:=TargetPath & myCell.Value & ".png", _
　　　　　　　　　　　　 LinktoFile:=False, SaveWithDocument:=True, _
　　　　　　　　　　　　 Left:=0, Top:=0, Width:=0, Height:=0)
　　myShp.ScaleHeight 1, msoTrue
　　myShp.ScaleWidth 1, msoTrue
　　myShp.Left = myCell.Left + myCell.Width / 2 - myShp.Width / 2
　　myShp.Top = myCell.Top + myCell.Height / 2 - myShp.Height / 2
　Next myCell
　On Error GoTo 0
End Sub