Excelマクロ 指定したフォルダの先頭の画像を挿入する方法

エクセルマクロに関して質問です。
以下は私が作成し、今使用しているコードです。
ボタンを押すと作動するような形です。


Sub 写真格納()

p = ThisWorkbook.Path & "\外観\"

ro = 5
For co = 4 To 94 Step 10

f = Cells(ro, co) & ".JPG"

If Dir(p & f) <> "" Then

Set mycel = Range(Cells(ro + 3, co + 1), Cells(ro + 9, co + 8))
Set mySp = ActiveSheet.Shapes.AddPicture(Filename:=p & f, LinkToFile:=False, SaveWithDocument:=True, Left:=mycel.Left, Top:=mycel.Top, _
Width:=0, Height:=0) '★ とりあえず 縦横０で。
mySp.ScaleHeight 1, msoTrue '★元のサイズに戻す
mySp.ScaleWidth 1, msoTrue '★元のサイズに戻す
' mySp.Height = mycel.Height
mySp.Width = mycel.Width
Set mySp = Nothing
Set mycel = Nothing
End If

end sub


仕様は以下の通りです。
私はそれぞれ製品の写真とそれぞれの銘板などの写真を撮り、製品ナンバーでフォルダ別けをしています。今回このエクセルのシートで使いたいのは製品の写真です。毎回撮るときは一番初めに写真をとり、その後に銘板などを撮るため、フォルダわけした際に確実にどの製品フォルダも一番初めに挿入したい画像が来ます。

１、このエクセルのファイルはAというフォルダに入っています。
２、そのフォルダには外観写真というフォルダが入っており、その中に画像ファイルが入っています。
３、セルD5,N5,X5...CP5に画像ファイル名である数字が入っています。
D5には１、N5には２という形で１０まで。
４、その名前を外観写真というフォルダから検索しE8,O8,Y8...CQ 8のセルにそれぞれ画像を挿入する
というような形です。


しかしこれではいちいち製品の写真を外観写真というフォルダに集め、ファイル名を1,2,3,4...10というように変えなければいけません。フォルダで１,2,3...１０とわけそれぞれの1番先頭にある写真（ファイル名は撮った写真名のままで今みたいに変えるのが面倒だと感じております。）を同じような形で挿入したいです。

このような仕様は可能でしょうか？
可能な場合教えていただきたいです。

No.1 回答者： ゆや 回答日時： 2015/11/28 06:16

質問とは異なりますがファイルやフォルダのリネームは数多くの手法があり、ツールもあります

それらを利用するとマクロを変更せずに作業が短縮できるかと思います

そして本題ですが、可能です
少し手を加えるだけで大丈夫だと思われるので、以下に示します
ro = 5
For co = 4 To 94 Step 10

'Cells(ro, co)に1~10が入っているとのことですから、フォルダを示す数字として流用しています
p = ThisWorkbook.Path&"\"Cells(ro, co)&"\"

'フォルダの存在確認
If Dir(p, vbDirectory) <> "" Then

'最初にある拡張子がJPGのファイルを選びます
f = Dir(p & "*.JPG")

'実際にあるファイルから名前を取得しているため、ファイルに対するチェックは不要です
'以降は既存のマクロと同じです
Set mycel = Range(Cells(ro + 3, co + 1), Cells(ro + 9, co + 8))