VBA 202号室：描画オブジェクトの有無確認

VBAｰShapesオブジェクトを使って、シート内にある描画オブジェクトに対してオブジェクト名を指定して有無を確認する

Kappo

Excel上にあるQRコードを操作する前に、シート上に配置されているかどうか確認するプログラムですよ
削除やQR内のプロパティを変更するのに存在していないと、予期しないエラーが発生してプログラムが止まってしまいますよね！
そこで、この部屋では予め自分ルールでQRコードオブジェクトの名前を決めておいて、シート内をチェックしその後のプログラム操作に役立てる方法を書いてます
また、一番したの方にコメント欄があるからよかったら質問・感想などメッセージ入れてください

■■■QRコードを配置したサンプルExcelを準備します（例）■■■
※作成方法は「QRコードを配置したサンプルExcelを準備します（例）」を参照してください

Excelシート内で指定した描画オブジェクトの有無を確認するプログラム
呼びだすプログラム（例）
プログラムの実行

Excelシート内で指定した描画オブジェクトの有無を確認するプログラム

●●サブルーチンプログラム●●
「VBA：描画オブジェクトの名前取得」で追加した標準モジュール（QrCtrl）にブログラムを記述

サブルーチンの内容
ShapeObjCheck(stName As String, shpType As Integer, shpName As String)

引数： stName＝シート名、shpType＝描画オブジェクトのタイプ、
　　　　shpName＝描画オブジェクトの名前
　　　　　・・・オブジェクトを選択するとExcel上部に表示（下図の赤枠の箇所）

戻り：見つかった＝True、無かった＝False

▼プログラム▼

Public Function ShapeObjCheck(stName As String, shpType As Integer, shpName As String)

    Dim shp As Shape
    Dim hitFlag As Boolean

    hitFlag = False

    'シート内の描画オブジェクトをループ
    For Each shp In ThisWorkbook.Worksheets(stName).Shapes

        If shp.Type = shpType Then
            Debug.Print(shp.Name)

            If shp.Name = shpName Then
                hitFlag = True
                Exit For
            End If

        End If

    Next shp

    ShapeObj = hitFlag

End Function

呼びだすプログラム（例）

サブルーチンプログラムが出来たので呼びだすコマンドボタンを配置してプログラムを記述する
※ボタンの配置方法は「VBA：描画オブジェクトの名前取得」を参照してください

コマンドボタンがクリックされた時に実行されるプログラム

Dim ret As Boolean

'------------------------------
'オブジェクト指定＝描画オブジェクト：msgOLEControlObject（値=12）
'名前＝QRコード1

ret = ShapeObjCheck("Sheet1", msoOLEControlObject, "QRコード1")

If ret = True Then

    Call MsgBox("オブジェクト＝" & msoOLEControlObject & " : 名前＝QRコード1" & " はあります")

Else

    Call MsgBox("オブジェクト＝" & msoOLEControlObject & " : 名前＝QRコード1" & " はありません")

End If

'------------------------------
'オブジェクト指定＝描画オブジェクト：msgOLEControlObject（値=12）
'名前＝QRコード2

ret = ShapeObjCheck("Sheet1", msoOLEControlObject, "QRコード2")

If ret = True Then

    Call MsgBox("オブジェクト＝" & msoOLEControlObject & " : 名前＝QRコード2" & " はあります")

Else

    Call MsgBox("オブジェクト＝" & msoOLEControlObject & " : 名前＝QRコード2" & " はありません")

End If