マクロでセルに入れたファイル名の画像を読み込む

マクロ初心者なのですが、仕事で型番を元に画像を読み込むリストを作成したく、他の方のマクロを参照に下記の通り作成したところ、成功しました。

このマクロだと、縦一列にしか画像を読み込めないので、資料を作成する時には画像をカットアンドペーストして作り直していました。
しかし時間がかかるので、下記添付のように横にも画像を読み込めるマクロがあれば教えて頂けますでしょうか。（見易いように、列は途中で非表示にしているものがあります）
私が現在使用しているマクロは下記の通りとなります。

尚、現在は新しく画像を読み込むときは以前の画像を手動で全て消してからマクロを実行しているのですが、手動で画像を消さなくてもマクロで消す方法もあれば幸いです。
（現在、画像を全部選択して消去しているのですが、そのときにマクロを実行するコマンドボタンも一緒に消えてしまうので、その都度コマンドボタンを他に移し変えているので。。。。）

もしくは、画像を全選択する時に、マクロ実行ボタン選択されないようにする方法があれば幸いです。

初歩的な事を色々とお聞きして誠に申し訳ありませんが、教えて頂けたらと思います。
宜しくお願い致します。


Private Sub CommandButton1_Click()

Sub try()
Const n As Long = 2 'margin
Dim r As Range
Dim i As Long
Dim x As Double
Dim s As String

With ActiveSheet
For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row Step 6
Set r = .Cells(i, 3).MergeArea
s = "C:YM\" & .Cells(i, 2).Value & ".JPG"
If Dir(s) = "" Then
s = "C:YM\noimage.JPG"
Else
Dir Application.Path
End If
'r.Item(1).Value = s
With .Pictures.Insert(s).ShapeRange
.LockAspectRatio = msoTrue
x = Application.Min(r.Width / .Width, (r.Height - n) / .Height)
.Width = .Width * x
.Left = r.Left + (r.Width - .Width) / 2
.Top = r.Top + (r.Height - .Height) / 2

End With
Next
End With

Set r = Nothing
End Sub

No.1 ベストアンサー 回答者： めぐみん_ 回答日時： 2018/01/07 18:19

まず最初に一言。

『一切検証してません。ダメでしたらごめんなさい。』

提示されているコード自体は完全ではないにしろキチンと動いていると信じ、ちょこっと細工しました。

Sub try_1()
Const n As Long = 2 'margin
Dim r As Range
Dim i As Long
Dim x As Double
Dim s As String
Dim c As Variant '★追加

With ActiveSheet
For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row Step 6
For Each c In Array("B", "T", "AL", "BD") '★追加
Set r = .Cells(i, c).Offset(, 1).MergeArea '☆変更
s = "C:YM\" & .Cells(i, c).Value & ".JPG" '☆変更
If Dir(s) = "" Then
s = "C:YM\noimage.JPG"
Else
Dir Application.Path
End If
'r.Item(1).Value = s
With .Pictures.Insert(s).ShapeRange
.LockAspectRatio = msoTrue
x = Application.Min(r.Width / .Width, (r.Height - n) / .Height)
.Width = .Width * x
.Left = r.Left + (r.Width - .Width) / 2
.Top = r.Top + (r.Height - .Height) / 2

End With
Next '★追加
Next
End With

Set r = Nothing
End Sub

なお削除の件についてはどのようにされているのかはわかりませんでしたが、ShapeのTopLeftCellプロパティの『行（Row）』を取得し、
１行目を超えている物だけを削除で宜しいのなら、

Sub try_2()
Dim ss As Shape

For Each ss In ActiveSheet.Shapes
If ss.TopLeftCell.Row > 1 Then ss.Delete
Next

End Sub

こちらで如何でしょう。
方法としてはtry_1の最初の方に組み込んでも良いかもですけど、判断はお任せします。

ご参考になれば幸いです。

この回答へのお礼

早速ご返答頂きありがとうございます。

教えて頂いた通り変更したところ、希望通り画像を読み込むことができました。また、以前の画像を全て消去する方法も、try_1の最初の方に組み込んだのですが、上手くいきました。

本当に助かりました。
ありがとうございます！！！！！！

お礼日時：2018/01/08 13:10