選択に応じた図形・画像を取得する

ワークシート内の図形・画像(Shape オブジェクト)のうち、直接選択されているもの、または選択セルに位置するものを取得します。

選択している図形・画像を取得するコード

Dim oShp As Shape   

For Each oShp In Selection.ShapeRange
    '各図形・画像の処理
    MsgBox oShp.Name
Next oShp
直接選択 Shape を ShapeRange コレクションで取得

ユーザーが選択した画像・図形を取得するのは比較的単純です。

Selection.ShapeRange で、選択された Shape のコレクションを取得できます。コレクション内の各 Item が該当 Shape オブジェクトになります。

選択セルに配置されている画像・図形を取得するコード

図形・セル選択

Dim oShp As Shape

For Each oShp In ActiveSheet.Shapes
    '選択セルと画像配置セルを照合
    If Not (Intersect(oShp.TopLeftCell, Selection) Is Nothing) Then
       '各図形・画像の処理 
       MsgBox oShp.Name
    End If
Next oShp
選択セルに配置された Shape を TopLeftCellプロパティで選別

メニューやダイアログボックスでは、図形・画像の位置情報を確認することはできません。VBAで取得できる位置情報の LeftTop はシートの端からの距離なのでセルとの位置関係がつかめません。TopLeftCell は、これを解決してくれる便利なプロパティです。画像・図形の左上端が位置するセルを返してくれるのです。

あとはIntersect メソッドで、 TopLeftCell で取得したセルが選択セル範囲(Selection)に含まれていることが確認できれば、該当 Shape ということになります。

直接選択とセル範囲選択を識別して併用するコード

上記2つのコードを併用して、画像・図形の直接選択と配置セル範囲の選択との両方に対応するコードです。

Dim oShpRng As ShapeRange
Dim oRng As Range
Dim oShp As Shape   

'選択された Shape、選択されたセルを取得。一方はエラー(Nothing)になる
On Error Resume Next
Set oShpRng = Selection.ShapeRange
Set oRng = Selection
On Error GoTo 0

'Shape を直接選択の場合
If Not (oShpRng Is Nothing) Then
    For Each oShp In oShpRng
        '各図形・画像の処理
        MsgBox oShp.Name
    Next oShp
End If

'選択セル範囲に含まれるShape
If Not (oRng Is Nothing) Then
    For Each oShp In ActiveSheet.Shapes
        '選択セルと画像配置セルを照合
        If Not (Intersect(oShp.TopLeftCell, oRng) Is Nothing) Then
            '各図形・画像の処理
            MsgBox oShp.Name
        End If
    Next oShp
End If
選択状態の判別

oShpRng As ShapeRangeoRng As Range に選択された対象をセットしています。

画像・図形とセルとは同時に選択はできないので、これらのどちらかが処理の対象ということになります。結果として、一方の変数には代入され、他方の変数の代入はエラーになります。

 

タイトルとURLをコピーしました