VBA amacoda

図形は2つのコレクションオブジェクトを持っている – ShapesとDrawingObjects

Drawing graphics have two collection objects – Shapes and DrawingObjects

 

1つ目はShapesコレクションオブジェクト

会社で、直線と矢印だけを削除するマクロを作ってほしいと頼まれ、作ってみました。

図形を扱うマクロを書く必要性に迫られたことがないので、Shapesコレクションオブジェクトがあることは知っていましたが、書くのは初めてでした。

今回はカンタンなマクロなので、ファイルは作成しませんでした。ソースをコピペで十分だと思います。

まずは、ソースをご覧ください。

Sub S_DeleteLines_Sample0()
    Dim myWorksheet As Worksheet: Set myWorksheet = ActiveSheet
    
    With myWorksheet
        Dim ShapeNumber As Long: ShapeNumber = .Shapes.Count
        Dim i As Long
        
        If ShapeNumber = 0 Then Exit Sub
        
        For i = 1 To ShapeNumber
            Debug.Print .Shapes(i).Name
        Next i
    End With
    
    Set myWorksheet = Nothing
End Sub

これは最初に書いた調査用のマクロです。

「Dim ShapeNumber As Long: ShapeNumber = .Shapes.Count」で図形の数を調べ、「Debug.Print .Shapes(i).Name」で図形の名前をイミディエイトウィンドウに表示します。その表示された名前を元に直線と矢印を削除しようという考えです。

まずは、画像のように、シート上にすべての画像を並べました。

その上で、この調査用のマクロを実行しました。

そして、表示されたすべての名前がこちら。

Straight Connector 1049671
Straight Arrow Connector 1049673
Straight Arrow Connector 1049675
Elbow Connector 1049677
Elbow Connector 1049679
Elbow Connector 1049681
Curved Connector 1049683
Curved Connector 1049685
Curved Connector 1049687
Freeform 1049688
Freeform 1049689
Freeform 1049690
Rectangle 1049691
Rounded Rectangle 1049692
Snip Single Corner Rectangle 1049693
Snip Same Side Corner Rectangle 1049694
Snip Diagonal Corner Rectangle 1049695
Snip and Round Single Corner Rectangle 1049696
Round Single Corner Rectangle 1049697
Round Same Side Corner Rectangle 1049699
Round Diagonal Corner Rectangle 1049700
Textbox 1049701
Textbox 1049702
Oval 1049703
Isosceles Triangle 1049704
Right Triangle 1049705
Rarallelogram 1049706
Trapezoid 1049707
Diamnond 1049708
Regular Pentagon 1049709
Hexagon 1049710
Heptagon 1049711
Octagon 1049712
Decagon 1049713
Dodecagon 1049714
Pie 1049715
Chord 1049716
Teardrop 1049717
Frame 1049718
Half Frame 1049719
L-Shape 1049720
Diagonal Stripe 1049721
Cross 1049722
Plaque 1049723
Can 1049724
Cube 1049725
Bevel 1049726
Donut 1049727
"No" Symbol 1049728
Block Arc 1049729
Folded Corner 1049730
Smiley Face 1049731
Heart 1049732
Lightning Bolt 1049733
Sun 1049734
Moon 1049735
Cloud 1049736
Arc 1049737
Double Bracket 1049738
Double Brace 1049739
Left Bracket 1049740
Right Bracket 1049741
Left Bracket 1049742
Right Brace 1049743
Right Arrow 1049744
Left Arrow 1049745
Up Arrow 1049747
Down Arrow 1049747
Left-Right Arrow 1049748
Up-Down Arrow 1049749
Quad Arrow 1049750
Left-Right-Up Arrow 1049751
Bent Arrow 1049752
U-Turn Arrow 1049753
Left-Up Arrow 1049754
Bent-Up Arrow 1049755
Curved Right Arrow 1049756
Curved Left Arrow 1049757
Curved Up Arrow 1049758
Curved Down Arrow 1049759
Striped Right Arrow 1049760
Notched Right Arrow 1049761
Pentagon 1049762
Chevron 1049763
Right Arrow Callout 1049764
Down Arrow Callout 1049765
Left Arrow Callout 1049766
Up Arrow Callout 1049767
Left-Right Arrow Callout 1049768
Quad Arrow Callout 1049769
Circular Arrow 1049770
Plus 1049771
Minus 1049772
Multiply 1049773
Division 1049774
Equal 1049775
Not Equal 1049776
Flowchart: Process 1049777
Flowchart: Alternate Process 1049778
Flowchart: Decision 1049779
Flowchart: Data 1049780
Flowchart: Predefined Process 1049781
Flowchart: Internal Storage 1049782
Flowchart: Document 1049783
Flowchart: Multidocument 1049784
Flowchart: Terminator 1049785
Flowchart: Preparation 1049786
Flowchart: Manual Input 1049787
Flowchart: Manual Operation 1049788
Flowchart: Connector 1049789
Flowchart: Off-page Connector 1049790
Flowchart: Card 1049791
Flowchart: Punched Tape 1049792
Flowchart: Summing Junction 1049793
Flowchart: Or 1049794
Flowchart: Collate 1049795
Flowchart: Sort 1049796
Flowchart: Extract 1049797
Flowchart: Merge 1049798
Flowchart: Stored Data 1049799
Flowchart: Delay 1049800
Flowchart: Sequential Access Storage 1049801
Flowchart: Magnetic Disk 1049802
Flowchart: Direct Access Storage 1049803
Flowchart: Display 1049804
Explosion 1 1049805
Explosion 2 1049806
4-Point Star 1049807
5-Point Star 1049808
6-Point Star 1049809
7-Point Star 1049810
8-Point Star 1049811
10-Point Star 1049812
12-Point Star 1049813
16-Point Star 1049814
24-Point Star 1049815
32-Point Star 1049816
Up Ribbon 1049817
Down Ribbon 1049818
Curved Up Ribbon 1049819
Curved Down Ribbon 1049820
Vertical Scroll 1049821
Horizontal Scroll 1049822
Wave 1049823
Double Wave 1049824
Rectangular Callout 1049825
Rounded Rectangular Callout 1049826
Oval Callout 1049827
Cloud Callout 1049828
Line Callout 1 1049829
Line Callout 2 1049830
Line Callout 3 1049831
Line Callout 1 (Accent Bar) 1049832
Line Callout 2 (Accent Bar) 1049833
Line Callout 3 (Accent Bar) 1049834
Line Callout 1 (No Border) 1049835
Line Callout 2 (No Border) 1049836
Line Callout 3 (No Border) 1049837
Line Callout 1 (Border and Accent Bar) 1049838
Line Callout 2 (Border and Accent Bar) 1049839
Line Callout 3 (Border and Accent Bar) 1049840

この中で直線・矢印に関係するのは、この3つ。

Straight Connector 1049671
Straight Arrow Connector 1049673
Straight Arrow Connector 1049675

先頭の8文字が「Straight」なのは、この3つの図形だけ。図形の名前から「Left」関数で8文字抜き出して「Straight」に該当するものだけを処理することにします。

そのソースがこちら。

Sub S_DeleteLines_Sample1()
    Dim myWorksheet As Worksheet: Set myWorksheet = ActiveSheet
    
    With myWorksheet
        Dim ShapeNumber As Long: ShapeNumber = .Shapes.Count
        Dim ShapeNames() As String: ReDim ShapeNames(1 To ShapeNumber)
        Dim i As Long
        
        If ShapeNumber = 0 Then Exit Sub
        
        For i = 1 To ShapeNumber
            ShapeNames(i) = .Shapes(i).Name
        Next i
        
        For i = 1 To ShapeNumber
            If Left(ShapeNames(i), 8) = "Straight" Then
                .Shapes(ShapeNames(i)).Delete
            End If
        Next i
    End With
    
    Set myWorksheet = Nothing
End Sub

これが長いマクロなら正解なのですが、ここまで短いマクロだと、余計な処理が目につきます。

・変数「ShapeNumber」が余計。図形の数はShape.Countプロパティをそのまま使っても可読性は落ちない。
・配列「ShapeNames()」が余計。図形の名前はShape(i).Nameプロパティを使えばよい。

以上を踏まえたソースコードがこちら。

Sub S_DeleteLines_Sample2()
    Dim myWorksheet As Worksheet: Set myWorksheet = ActiveSheet
    
    With myWorksheet
        Dim i As Long
        
        If .Shapes.Count = 0 Then Exit Sub
        
        For i = .Shapes.Count To 1 Step -1
            If Left(.Shapes(i).Name, 8) = "Straight" Then
                .Shapes(i).Delete
            End If
        Next i
    End With
    
    Set myWorksheet = Nothing
End Sub

かなり短くなりました。

 

もう1つの図形コレクションオブジェクトとは

DrawingObjects

「DrawingObjects」コレクションオブジェクトは、「Shapes」コレクションオブジェクト・「Shape」オブジェクトがない頃から使われているオブジェクトであり、「シート上のすべての図形」を表します。

「Shapes」・「Shape」が使われるようになってから、「DrawingObjects」が使われなくなってもおかしくないのですが、実は全部の機能＝インターフェイス（プロパティ・メソッド）が引き継がれたわけではないのです。

例えば、

Activesheet.Shapes.Delete

はエラーになり、

Activesheet.DrawingObjects.Delete

はエラーになりません。

これは、「DrawingObjects」の「Delete」メソッドが「Shapes」に引き継がれず、「Shapes」には「Delete」メソッドが存在しないからです。

だから、シート上のすべての図形を一括で削除する一番簡単な方法は「DrawingObjects」を使うことです。

 

では、直線・矢印を表すオブジェクトはないのか

あります。オブジェクトブラウザで「lines（直線の意）」を検索すると出てきません。そこで、「非表示のメンバーを表示」にチェックを入れると、「Worksheet」の中に「Lines」があります。

同様に古いタイプの図形には一括で操作できるものがあります。それがこれらです。

Lines    : 直線・矢印
Ovals    : 楕円・円
Rectangle: 四角形
TextBoxes: テキストボックス
Drawings : フリーハンド
Pictures : 画像

以上を踏まえて、最終的に出来上がった最もシンプルな直線・矢印を削除するソースコートがこれです。

Sub S_DeleteLines_Sample3()
    If ActiveSheet.Lines.Count = 0 Then Exit Sub
    ActiveSheet.Lines.Delete
End Sub

 

おわりに

図形（描画オブジェクト）を操作するには、「Shapes」「Shape」だけではなく、「DrawingObjects」や古いタイプの図形オブジェクトも学びましょう。

コメントを残す

RECOMMENDこちらの記事も人気です。