エクセル 選択しているセル範囲に図形が存在しているか(有無)を確認(Excel VBA)

【本日のミッション】

エクセルの選択しているセル範囲に、図形が存在しているかどうかを確認せよ。

ミッションの概要

エクセルの選択しているセル範囲に、図形が存在しているかどうかを確認するのが今回のミッションです。


↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓


↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

■■■スポンサーリンク■■■

プロシージャ

図形の存在を確認するシートをアクティブにした状態で、Alt+F11でVsual Basic Editerを起動します。

[挿入]-[標準モジュール]で新規モジュールを作成し、下記の通りコードを記入します。

Sub 選択セル上の図形有無を判定()
    '【変数】
    Dim ran As Range    '図形配置セル
    Dim shp As Shape    'オブジェクト
    Dim fg As Integer   'fg=1 選択セル上に図形あり

    '■セルを選択しているか確認
    If TypeName(Selection) <> "Range" Then
        Exit Sub
    End If
    '■アクティブシートのオブジェクトを順に処理
    For Each shp In ActiveSheet.Shapes
    
        '■オブジェクトが図形か判定
        If shp.Type = msoAutoShape Then 
   
            '■図形配置セルを変数ranにセット
            Set ran = Range(shp.TopLeftCell, shp.BottomRightCell)
            
            '■図形配置セルと選択セルが重なっているか判定
            If Intersect(ran, Selection) Is Nothing = False Then
                fg = 1
            End If
        End If
    Next

    '■選択セル上の図形有無ダイアログ表示
    If fg = 1 Then
        MsgBox "選択セルの上に図形は存在します。"
    Else
        MsgBox "選択セルの上に図形は存在しません。"
    End If

End Sub

記入したプロシージャ(Sub~End Subまで)のどこかにカーソルを置いてF5キーをクリックしてください。

選択セルの上に図形が存在している時は「選択セルの上に図形は存在します。」とダイアログ表示されます。


↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

選択セルの上に図形が存在していない時は「選択セルの上に図形は存在しません。」とダイアログ表示されます。


↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

■■■スポンサーリンク■■■

Intersectメソッド

引数に指定した、複数のセル範囲の重なっているRangeオブジェクトを返します。
重なりがない場合は「Nothing」を返します。

Intersect(セル範囲1, セル範囲2, ・・・, セル範囲30)
引数説明省略
セル範囲1セル範囲 (Range オブジェクト) を指定します。
セル範囲2セル範囲 (Range オブジェクト) を指定します。
セル範囲3~セル範囲30セル範囲 (Range オブジェクト) を指定します。

引数に指定したセル範囲に重なっている部分がある場合は、Rangeオブジェクトを返します。
重なっているセル範囲のアドレスを調べるには、下記例のようにAddressプロパティを使います。

MsgBox Intersect(Range("B3:E10"), Range("E10:F12")).Address

引数に指定したセル範囲に重なっている部分がない場合は、「Nothing」を返します。
「Nothing」を返しているかを調べるには、下記例のように「Is Nothing」を後ろにつけます。「True」となったら「重なるセル範囲は無い」と判断します。

MsgBox Intersect(Range("B3:E10"), Range("F11:G13")) Is Nothing

重なるセル範囲は無い

逆に、「False」となるときは「重なるセル範囲はある」と判断します。

MsgBox Intersect(Range("B3:E10"), Range("E10:F12")) Is Nothing

←重なるセル範囲はある

今回は、図形配置セルの変数「ran」と、選択しているセル「Selection」で、重なっているセル範囲があるかどうか判定しています。

シート内に複数のオブジェクトがあるので、For Eachを使って順に処理していきます。「If shp.Type = msoAutoShape Then」で図形のみを処理するようにしています。

1つ目の図形のセル範囲選択セルを判定↓
重なりがあるので「変数fg=1」となります。

2つ目の図形のセル範囲選択セルを判定↓

3つ目の図形のセル範囲選択セルを判定↓

いずれかの図形のセル範囲「ran」と、選択セル「Selection」が重なっている場合に「変数fg=1」とするようにしています。
処理の最後に fg=1 となっている場合、「選択セルの上に図形は存在します。」とダイアログ表示させています。

If Intersect(ran, Selection) Is Nothing = False Then
    fg = 1
End if
    ・
    ・
If fg = 1 Then
    MsgBox "選択セルの上に図形は存在します。"
Else
    MsgBox "選択セルの上に図形は存在しません。"
End If

セルを選択しているか確認 TypeName関数

引数に指定した値の情報を返します。

TypeName(値)

今回は選択しているものが「セル」かどうかを判定しています。
セルを選択している場合、「Range」を返します。図形オブジェクトを選択している時は「Picture」を返します。

If TypeName(Selection) <> "Range" Then

For Eachとは

For Each 変数 In コレクション
    ***処理***
Next 変数  

とすることで、コレクションの中にあるもの1つ目から順に変数に入れて、Nextまでの処理を行い、コレクション内にあるもの全ての処理が終わったらNext以降の処理に移ります。

ActiveSheet.Shapesアクティブシート内のShapeコレクションオブジェクト全てのことです。その1つ目から順に変数「shp」として処理していきます。

全てのShapeコレクションオブジェクトの処理が済んだら、For Eachを抜けて次の処理に移ります。

Dim shp As Shape     'オブジェクト

For Each shp In ActiveSheet.Shapes
    ***shpを使用する処理***
Next shp

Shape.Typeプロパティ

Shapeオブジェクトが、どの種類のオブジェクトか判定するのに、下記Typeプロパティを使用します。使用頻度の高いTypeのみ記載しておきます。

定数説明
msoAutoShape1図形・オートシェイプ
msoCallout2吹き出し
msoChart3グラフ
msoComment4コメント
msoFreeform5フリーフォーム
msoGroup6グループ化された図形
msoFormControl8フォームコントロール
msoLine9
msoLinkedPicture11リンク画像
msoPicture13画像
msoTextBox17テキストボックス
msoCanvas20描画キャンバス
msoSmartArt24スマートアート

今回はShapeオブジェクトのタイプが、図形「msoAutoShape」かどうか判定しています。

If shp.Type = msoAutoShape Then

図形が配置されているセル範囲の取得 TopLeftCell・BottomRightCell

TopLeftCellは、Shapeオブジェクトの左上のセルを取得します。
BottomRightCellは、Shapeオブジェクトの右下のセルを取得します。

Shapeオブジェクト.TopLeftCell
Shapeオブジェクト.BottomRightCell

TopLeftCellBottomRightCellを使って、図形が配置されているセル範囲を取得することができます。
下記例は、雪だるまの図形を変数「shp」として処理しています。

MsgBox Range(shp.TopLeftCell, shp.BottomRightCell).Address

図形配置セルを変数にセット Setステートメント

今回は可読性を上げるために、図形が配置されているセル範囲を変数ranにセットしています。

Rangeオブジェクトをセットする変数は、あらかじめ「Range」のデータ型で宣言しておきます。Setステートメントで、変数にRangeオブジェクトをセットすることができます。

Dim Rangeオブジェクト変数 As Range
Set Rangeオブジェクト変数 = Rangeオブジェクト

下記は、Rnageオブジェクト変数ranに、セル範囲 Range(shp.TopLeftCell, shp.BottomRightCell)をセットしています。

Dim ran As Range
Set ran = Range(shp.TopLeftCell, shp.BottomRightCell)

参照

系列が1つのグラフを自動大量連続作成(Excel VBA)
「実行時エラー 1004」を出さずに、ワークシート内のグラフを「グラフ 元」以外全て削除(Excel VBA)
グラフの参照先を変えると勝手にグラフの色が変わる現象を解決せよ
系列が複数あるグラフを自動大量連続作成(Excel VBA)
n行毎の改ページ設定 「実行時エラー1004 RangeクラスのPageBreakプロパティを設定できません」の原因(Excel VBA)
参照データ数が異なる・参照先が変動する月別グラフを自動大量連続作成(Excel VBA)
複数系列・参照データ数が異なる・参照先が変動する月別グラフを自動大量連続作成(Excel VBA)
大量の画像やグラフ等のオブジェクトで画面表示が遅いのを解決(Excel)
エクセル シートに画像が存在するかどうか(有無)を調べる方法(Excel VBA)
エクセルシート上 全てのオブジェクト(画像・図形・グラフ等)を選択し、削除する(Excel VBA)
エクセルシート上のオブジェクト(図形・画像・グラフ等)の件数を数える方法(Excel VBA)
エクセル シートにグラフが存在するかどうか(有無)を調べる方法(Excel VBA)
エクセル シートに図形が存在するかどうか(有無)を調べる方法(Excel VBA)
エクセル 選択しているセル範囲に写真が存在しているか(有無)を確認(Excel VBA)
エクセル 選択しているセル範囲にグラフが存在しているか(有無)を確認(Excel VBA)
エクセル 選択しているセル範囲に図形が存在しているか(有無)を確認(Excel VBA)
エクセル 選択セル範囲の写真を削除する(Excel VBA)
エクセル 選択セル範囲のグラフを削除する(Excel VBA)
エクセル 選択セル範囲の図形を削除する(Excel VBA)
Excel VBAでワードを起動して文字を入力操作(Excel VBA)
Excel VBAでワードを起動してエクセルの表をワードに貼付け(Excel VBA)
Excel VBAでワードを起動して エクセルのエクセルの表を図としてワードに貼付け(Excel VBA)
Word コピー貼付けした図が白い枠だけ?図が表示されない現象を解決
Excel VBAでワードを起動して グラフをワードに図として貼付け(Excel VBA)

■■■スポンサーリンク■■■