VBA 大量の画像を指定の場所に貼り付ける際に成功するときとエラーが発生するときがある

前提・実現したいこと

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

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

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

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

少し調べたところ、nothingの場合の処理を入れるといいみたいなのですが、
nothingの場合はH列に「NG」と入力するようにしたいです。
ネットで調べると、
Set r = Cells.Find("test")
If Not r Is Nothing Then
のような書き方でsetが使われていますが、
自分のは違う書き方になっているので対処方法がわかりません。
また、
Set objShape = からの動作もネットから持ってきたもので、H列に入力する処理方法もわからないので
教えていただけませんか？

該当のソースコード

Private Sub CommandButton1_Click()
    Call call_PasteImage
End Sub

'****************************************************************
' グローバル変数
'****************************************************************

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

Dim ImagePath As String ' 貼り付け用画像格納フォルダパス

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

ImagePath = Cells(pathRow, pathClm)
strFileName = Dir(Range("B4").Value & "\*.jpg")

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 & strFileName, _
                        LinkToFile:=False, _
                        SaveWithDocument:=True, _
                        Left:=ActiveCell.Left, _
                        Top:=ActiveCell.Top, _
                        Width:=ActiveCell.Width, _
                        Height:=ActiveCell.Height)

        strFileName = Dir()
    Loop

End Function

試したこと

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

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

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