オートシェイプの数をカウントするマクロ
0

    ご機嫌いかがかな?

     

    派祖混蔵じゃ。 はや正月も三が日をすぎたのう。

     

    では今回は前にも述べたとおりオートシェープをカウントするマクロを解説しようかの。

     

    では構文じゃ。

    あらかじめマウスでオートシェープをカウントする範囲を選択状態にしておくこと。

     

    ’変数の宣言
        Dim MyShapes As Shape ’オートシェイプの変数
        Dim i As Long ’選択範囲内のオートシェイプの数
        Dim j As Long ’シート内のオートシェイプの数
        Dim Aria As Object ’選択範囲を格納する変数 

        Set Aria = Selection ’マウスで指定した範囲を変数にセット
        Application.ScreenUpdating = False ’画面が動かないようにする

     

        For Each MyShapes In ActiveSheet.Shapes ’シート内のオートシェイプを変数に順番に格納
            With MyShapes
                'オートシェイプが選択範囲内のものか判断(オートシェイプの左端&右下の位置が選択範囲内に入っているかで判断)
                If Not Intersect(.TopLeftCell, Aria) Is Nothing And _
                    Not Intersect(.BottomRightCell, Aria) Is Nothing Then 
                   i = i + 1 ’選択範囲内ならカウントプラス
                End If
            End With
            j = j + 1 ’シート内のオートシェイプをカウントプラス
         Next
         MsgBox "全:" & j & "  選択内:" & i ’オートシェイプのシート内の数と選択範囲の数を表示
         Aria.Select
    End Sub

     

    上記の構文でシート内の全オートシェイプの数と選択範囲内の数がわかるが、注意しなければならないのはオートシェイプがグループ化されている時じゃ。

    複数のオートシェイプがグループ化されている場合は1つにカウントされるのじゃ。

    もしマクロで個別にオートシェイプを削除しようとするとグループ化されていた場合は削除できない。

    こういう場合は一旦グループ化を解除せねばならん。

     

    解除したい場合はここからじゃ。

    ’オートシェイプのグループ化を解除する構文
        If ActiveSheet.Shapes.Count = 0 Then ’シート内にオートシェイプがあるか判別
           Exit Sub ’オートシェイプが無い場合、プログラムを中止する
        Else ’オートシェイプが合った場合、全図形のグループ化を解除する

           Dim has_grp As Boolean  'グループ化図形があることを示すフラグ
           Dim shp As Shape ’オートシェイプの変数
           has_grp = True ’フラグを仮にオートシェイプがグループ化されていることにする
           Do While has_grp ’has_grp が Trueの時に繰り返す
              For Each shp In ActiveSheet.Shapes ’シート内のオートシェイプを変数に順番に格納
                 If shp.Type = msoGroup Then ’オートシェイプがグループ化されているか判別
                    has_grp = True ’グループ化されている場合、has_grp に Trueを代入
                    shp.Ungroup ’グループ化を解除する
                 Else ’グループ化されていない場合
                    has_grp = False ’グループ化されて無い場合、has_grp に Falseを代入
                 End If
              Next shp
           Loop
        End If

     

    ところでオートシェイプをすべて削除するのは簡単じゃ。

    「選択オプション」ダイアログで「オブジェクト」を選択しOKボタンを押す。するとすべてのオートシェイプが選択されているのであとは「Delete」ボタンを押すだけですべて削除される。

    「選択オプション」ダイアログはエクセルのバージョンで出し方が違うのでここでは省略する。

    マクロでオートシェイプの全削除は1行で済む。

     

    ActiveSheet.DrawingObjects.Delete

     

    たったこれだけじゃ。

     

    ちなみに選択範囲のオートシェイプを削除する場合は最初の構文の

      i = i + 1 ’選択範囲内ならカウントプラス

    この部分を

      .Delete

    とすればよい。ただし、グループ化を解除することが必要じゃ。

     

    本日はここまでじゃ。ふうー疲れたわい。

    おまけ動画!
    派祖混蔵のコーナリングを見よ!



    | 派祖混蔵 | エクセルの技じゃ! | 11:08 | comments(0) | trackbacks(0) | - | - |