Excel VBA マクロ 画像の貼り付け

あるフォルダには、複数のjpgファイルとそれを整理するためのマクロを組んだExcelファイルが入っています。このjpgファイルの名前は数字です。
このExcelファイルのSheets(1)のA列(Range("A5")から)にファイルの名前である数字が昇順で入っています。（jpgファイル名をExcelに書き出し、昇順に並べるマクロを作成したので）
この数字の横(B列)にそのjpg画像を貼り付けたいです。
また、数字は100以上あり、連続しておらず、ところどころぬけています。
そのため、画像を貼り付けようとすると最小の数字が24であっても100の画像が挿入されてしまいます。

【質問】A列に入力されている名前のjpgファイルを開き、その画像をB列に挿入するにはどのようなコードを書けば良いでしょうか？

コードは、長くなりすぎる＆初心者なものでどこを省略すればいいか分からないため、時数の問題で記載できかねます。申し訳ありません。

分かりづらい質問ですが、どなたかお力をお貸しください。

No.4 ベストアンサー 回答者： fujillin 回答日時： 2021/01/18 19:28

No3です

＞昇順に並べるマクロを作成したので
とあったので、マクロの話で通じるのかと思いましたが、どうやらほとんど通じないようなので、面倒なのでまとめて処理するものを作成してみました。

条件がよくわからないのでかなり適当ですが、雰囲気からするとこんなことかなと、勝手な推測によるものです。
ですので、もしもはずれだったらご容赦。

Sub Sample_12152573_2()
Dim rg, fName, p, c

Const fPath = "C:\Users\hoge\fuga"　'←修正必要！！！！！！！
Set rg = Worksheets(1).Cells(5, 1)

fName = Dir(fPath & "\*.jpg")
　While fName <> ""
　rg.Offset(, 1).Value = fName
　fName = Dir()
　Set rg = rg.Offset(1)
Wend

If rg.Row < 6 Then Exit Sub
Set rg = rg.Worksheet.Cells(5, 1).Resize(rg.Row - 5)
rg.FormulaLocal = "=iferror(left(B5,len(B5)-4)*1,""非数"")"
rg.Value = rg.Value
rg.Resize(, 2).Sort key1:=rg.Cells(1, 1), order1:=xlAscending, Header:=xlNo

For Each c In rg.Offset(, 1).Cells
　fName = fPath & "\" & c.Value
　Set p = c.Worksheet.Shapes.AddPicture(fName, _
　　　False, True, c.Left, c.Top, c.Width, c.Height)
Next c
rg.Offset(, 1).ClearContents
End Sub

この回答へのお礼

面倒であれば無理にお答えいただかなくて結構でしたのにわざわざありがとうございました

お礼日時：2021/01/18 19:35

No.3 回答者： fujillin 回答日時： 2021/01/18 17:36

NO2です

＞察するに、セル〇〇に書いてあるファイルを開いて隣に貼り付けるという
＞操作はvbaではできないのでしょうか、、、？
できますよ。
No2に書いたのがその方法です。
（意味が通じていませんか？）
ファイル名が正しいのなら、そのまま正しいファイル名として利用すれば良いだけです。

この回答へのお礼

申し訳ありません。
恥ずかしながら、内容を理解できておりません。
時間をかけてまた読み直します。
また、内容が理解できないことで再び同じような質問をするかもしれませんが、私の理解力がないだけですので、ご気分は悪くしないでください。その質問はスルーしていただけたらと思います。

お礼日時：2021/01/18 17:52

No.2 回答者： fujillin 回答日時： 2021/01/18 17:05

No1です。

＞質問にも記載しましたが100などの1から始まる画像が先に来てしまうのです。
おや、そうでしたか。

ということは、A列のセルに入っている値はそのままファイル名ではない可能性が大ですね。
001.jpgは、多分 1 と表示されているものと推測しますので。
であるなら、セルに値を書き込む際に、同時に画像も読み込んでしまえば宜しいかと。
（わざわざ、処理を二つに分割する意味が不明）

A列に書き込むファイル名の「元のファイル名」（=本当のファイル名)をfNameとすれば、
そのままNo1の回答の（部分）が使えると思いますけれど？

変数rgが対象セル、fnameをファイル名（拡張子込み）とするならば、
Set p = rg.Worksheet.Shapes.AddPicture(fPath & "\" & fName, _
False, True, rg.Left, rg.Top, rg.Width, rg.Height)
の一文で貼付けができます。

この回答へのお礼

何度も申し訳ありません。
＞A列のセルに入っている値はそのままファイル名ではない可能性が大ですね
jpgファイルの名前は0からは始まらず、1の場合はそのまま「1.jpg」がファイル名です。「001.jpg」にはなっていません。そのため、ファイル名は正しく書き出されていると思います。

＞セルに値を書き込む際に、同時に画像も読み込んでしまえば宜しいかと
元々はファイル名と画像を同時に読み込んでいたのですが、やはり最小値が反応されず、別で行うしかないのか？と思ったのです。

察するに、セル〇〇に書いてあるファイルを開いて隣に貼り付けるという操作はvbaではできないのでしょうか、、、？

お礼日時：2021/01/18 17:28

No.1 回答者： fujillin 回答日時： 2021/01/18 16:10

こんにちは

ご質問のような内容の例はあちこちのサイトで見かけた記憶があるので、検索しさえすれば多数ヒットすると思いますけれど・・・？？


画像はセルサイズにぴったりでよいのかどうかも不明ですが（プロポーションを維持するのかどうか）、ひとまずセルに合わせるものとして、以下はそのような一例です。

※ ファイル名が数値がどうかのチェックはしていません。
※ フォルダ内のjpgファイルを全て対象とします。
※ ファイル名も同時に書き出しますので、Ａ列は空白でＯＫです

Sub Sample_12152573()
Dim rg, fName, p
Const fPath = "C:\Users\hoge\hoge" '←対象フォルダ

Set rg = Worksheets(1).Cells(5, 2)
fName = Dir(fPath & "\*.jpg")

While fName <> ""
　rg.Offset(, -1).Value = fName
　Set p = rg.Worksheet.Shapes.AddPicture(fPath & "\" & fName, _
　　　　False, True, rg.Left, rg.Top, rg.Width, rg.Height)
　fName = Dir()
　Set rg = rg.Offset(1)
Wend
End Sub

ご参考にでもなれば。

この回答へのお礼

こんにちは。
こちらはフォルダ内の画像を全て貼り付けるものではないでしょうか？
同じようなマクロをいったん組んだのですが、このように全て貼り付けるにしてしまうと、質問にも記載しましたが100などの1から始まる画像が先に来てしまうのです。
そこで、先に番号を並べてしまい、その隣に該当の画像を挿入する方法ならできるのでは？と考えたのです。
私が行いたいものはA列に書いてある番号をB列に貼り付けるといったものでして、、、

お礼日時：2021/01/18 16:51