指定先に複数枚の画像を貼り付けたい

Question

前提・実現したいこと

保存されている画像をExcelシートの指定の場所に貼り付ける。

簡単な説明として、
・Excelには「input」「チェックシート」の2つのシートがあります。
・「input」には画像の格納先のパスを入力する場所(B4セル)とマクロ実行のボタンがあります。
・「チェックシート」には画像のファイル名(拡張子なし)がF列に書かれている。
・今回はG列に画像を貼り付けていきたい。その時、左(F列)の名前と画像の名前が一致したとき、G列に貼り付けたい。

発生している問題・エラーメッセージ

シートの移動をするだけで終わってしまう。
既存の似ているものを少し変更して作成しようとしているため
自分自身あまりプログラムの内容を理解できていないため修正箇所がわかりません。

該当のソースコード

Private Sub CommandButton1_Click()
    Call call_PasteImage
End Sub

'【Path取得セル】"INPUT"シート
Public Const pathClm As Integer = 2 'B
Public Const pathRow As Integer = 4

Function call_PasteImage()
Dim objShape As Object
Dim strFileName As String
Dim strImgName As String
Dim ImagePath　As String

ImagePath= Cells(pathRow, pathClm)
strFileName = Dir(ImagePath& "*.bmp")

Sheets("チェックシート").Select
 
    Do Until Len(strFileName) = 0
        strImgName = Left(strFileName, Len(strFileName) - 4)
        
        Cells.Find(What:=strImgName).Activate
            ActiveCell.Offset(0, 1).Activate
    
        Set objShape = ActiveSheet.Shapes.AddPicture( _
                        fileName:=ImagePath_SYI & strFileName, _
                        LinkToFile:=False, _
                        SaveWithDocument:=True, _
                        Left:=ActiveCell.Left, _
                        Top:=ActiveCell.Top, _
                        Width:=ActiveCell.Width, _
                        Height:=ActiveCell.Height)
        
        strFileName = Dir()
    Loop
 
End Function

試したこと

ここに問題に対して試したことを記載してください。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

Comments

[Y.H.]

B4セル には具体的にどのような値が入っているのでしょうか？
"C:\temp\Images\"とかでしょうか？最後に"\"は付けてますか？

[kitagawasho]

>B4セル には具体的にどのような値が入っているのでしょうか？C:\work\01_実作業
>最後に"\"は付けてますか？
つけていないです。

[kitagawasho]

すみません。1つ追加で質問さしてください。
現在エラー文で、
実行エラー’91’;
オブジェクト変数またはWith変数が設定されていません。
となってしまいました。
Cells.Find(What:=strImgName).Activateの部分が色塗りされている状態です。
何が原因かわかりませんか？

[Y.H.]

ここに書いても気付かれないので、質問を編集し質問に記載しましょう。

[Y.H.]

>シートの移動をするだけで終わってしまう。
という発生している問題に対して私の回答では解決済みになりませんか？
別質問として後続の質問を立てられてますので、質問者さんご自身で自己回答として経緯を記載されこの質問は解決済みにされてはどうでしょうか。

Answer 1

strFileName = Dir(ImagePath& ".bmp")
上記の文を下記の文に変更
strFileName = Dir(Range("B4").Value & ".jpg")

変更したことにより、パスが通り画像が貼られるようになった

Answer 2

以下のようにするとfindRangeにNothingなどが入ってないでしょうか？
Cells.Findは検索したけど見つからなかった場合に、Nothingを返すのでActivateがエラーになります。

'Cells.Find(What:=strImgName).Activate
'↓
Dim findRange as Range 
Set findRange = Cells.Find(What:=strImgName)
findRange.Activate

---

B4セル には具体的にどのような値が入っているのでしょうか？C:\work\01_実作業
最後に""は付けてますか？

つけていないです。

以下のようにB4セルの値と、"*.bmp"を連結しているので、
B4セルの値がC:\work\01_実作業だと
C:\work\01_実作業*.bmpというファイルを探して存在しないため何も処理されないです。

strFileName = Dir(ImagePath& "*.bmp")

C:\work\01_実作業*.bmpというファイルを探さなければなりません。

B4セルの値の最後に\を付けるか、以下のようにしてください。

If Right(ImagePath,1) = "\" Then
   strFileName = Dir(ImagePath& "*.bmp")
Else
   strFileName = Dir(ImagePath& "*.bmp")
End If