EXCEL vba 列への判定 shape(画像)を持つか

Question

特定の列に対して、セル中に画像が持つかの判定をvbaでさせたいです。
画像でいうBが判断対象列,Cが判断結果記入列。
vba前のシート

B4,B7,B8セルは画像を持つので、C列に、それがわかるようにYをたてたいです。
vba後のシート

すいません、以下自分で調べましたが、２つの要素(列への判断・走査 x shapeを持つセルか)をマッシュアップできませんでした！
皆様のお知恵をお貸し頂ければ幸いです。
特定の列に対してジャッジしていく、というのは以下を流用しようと思いました。
0000006　のセルかをサーチしています。
リンク内容

セルが画像を持つか、は以下を参考にしようと思いました。
リンク内容

objShape という概念とrangeがなんか、、照合させる方法が？？でした。
何卒宜しくお願いします。

'以下ページより当画像向けに少々変更
'https://it-skill-memo.work/2019/09/14/%E3%80%90vba%E3%80%91%E5%88%97%E3%81%AE%E3%83%87%E3%83%BC%E3%82%BF%E3%82%92%E5%8F%96%E5%BE%97%E3%81%97%E3%81%A6dictionary%E3%81%AB%E8%A8%AD%E5%AE%9A%E3%81%99%E3%82%8B/#toc3
'変数の宣言を必須
Option Explicit

Sub Sample()
    
    Const TARGET_SHEET_NAME As String = "サンプルシート"
    Const TARGET_COLUMN As Integer = 2
    Const START_ROW As Integer = 2
    
    Dim endRow As Double
    Dim arrayData As Variant
    Dim data As Variant
    Dim dicDate As Object
    
    '最終行を取得
    endRow = Cells(START_ROW, TARGET_COLUMN).End(xlDown).Row
    
    '1列分のデータを取得
    With Worksheets(TARGET_SHEET_NAME)
        arrayData = Range(.Cells(START_ROW, TARGET_COLUMN), _
                        　.Cells(endRow, TARGET_COLUMN))
    End With
    
    'DictionaryのKeyに設定。Valueには空文字を設定
    Set dicDate = CreateObject("Scripting.Dictionary")
    For Each data In arrayData
        If Not dicDate.Exists(data) Then
            dicDate.Add data, ""
        End If
    Next

    '今回ここらへんに0000006探しではなく、B列がshapeかの判定をさせたいです。
    'そのためここをコメントアウト
    '特定の値の存在確認
    'If dicDate.Exists("0000006") Then
    '    MsgBox "0000006が存在しました"
    'End If

End Sub
コード

Answer 1

こんな感じでどうでしょうか。

Sub Sample()

    Const TARGET_SHEET_NAME As String = "サンプルシート"
    Const TARGET_COLUMN As Integer = 2

    Dim ws As Worksheet
    Set ws = Worksheets(TARGET_SHEET_NAME)
    Dim shp As Shape
    For Each shp In ws.Shapes
        If shp.TopLeftCell.Column = TARGET_COLUMN Then shp.TopLeftCell.Offset(, 1).Value = "Y"
    Next

End Sub

Comments

[raaarta]

ばっちりでした。
シンプルですね。。
rangeは使わない。shapesを判断して該当するなら、そのoffset使って判定結果をいれる。
学びになりましたm(__)m

[raaarta]

このQ御覧になる皆様、シンプルな素晴らしいコードを頂きました。