ワークシート上に少し複雑な画像を描くとします。たとえば、下のようなグラフ。いろいろな Shape オブジェクトが混在しています。
その個々のパーツをすべてグループ化しておかないと、何かと不便です。なぜかといえば、グループ化しておくと
(1) ほかのアプリケーション(たとえばイラストレーターなど)にコピーして編集したいと思った時に、手っ取り早く一括してコピーできる
(2) ワークシート上の適当な位置に描画しようとした場合、座標の複雑な計算を行わなくても、左上を原点に描画しておいて、完成してから適当な位置に一網打尽に移動させることができる
などの理由です。
グループ化は、ActiveSheet.Shapes.Range(nameArray).Group で行うことができます。しかしこれが意外と厄介。nameArray は配列ですが、パーツを描く度に配列の個数を動的に増やさなくてはならないし、同種のパーツをサブグループにして、入れ子の構成をしようとすると、交通整理が大変です。
そこで、グループ化専用のクラスを作ってみました。
返された名前を受け取って、リストアップしていくのが、次の SegmentClass です。
メソッド Add で名前を登録、最後に Group で登録された名前の図形群をグループ化し、その名前を返します。リストとなる配列は要素数が不定ですので、連想配列 segmentList を使って、その Keys をグループ化に使用することにしました。名前が重複すると困りますが、もともと重複した名前の図形群をグループ化すると不具合が起きるので、逆に好都合です。
これで、描画する関数内で適宜グループ化して呼び出し元にその名前を返すようにしていけば、ツリー状のサブグループをもったグループが完成します。
グループももともと Shape ですので、図形とグループが混在したものもグループ化できます。
クラスモジュール SegmentClass
Private segmentList As Object '----- constractor,destractor 'segmentList の用意と、解放 Private Sub Class_Initialize() Set segmentList = CreateObject("Scripting.Dictionary") End Sub Private Sub Class_Terminate() Set segmentList = Nothing End Sub '----- Shape の名前を segmentListに追加する 'shapeName は重複を許さないことに注意 Public Sub Add(shapeName As String) If Len(shapeName) = 0 Then Exit Sub segmentList(shapeName) = "" End Sub '------ 追加されたすべての Shape をグループ化して名前をつける 'グループ名を返す 'ActiveSheet は、適宜必要に応じて変更 Public Function Group(groupName As String) As String If segmentList.count > 1 Then With ActiveSheet.Shapes.Range(segmentList.keys).Group .name = groupName End With End If Group = groupName End Function
たとえば、次のように使います。
「枠を描画」とか「グラフ線を描画」とか書いてあるところに、AddShape を用いた実際の描画関数がはいります。それぞれ、描画した図形群の名前または Shape オブジェクトを返します。具体的な関数は、ここでは煩雑になるので、はしょりました。
call CreatePyramid("NewGraph") で、NewGraph という名前のグループが作成されます。その中には、枠線、グラフの線、目盛り線、表題が含まれていて、グラフの線と目盛り線はさらに下位のグループを含んでいます。
標準モジュール CreatePyramid()
'----- 各パーツを描画して、全体をグループ化する Public Sub CreatePyramid(myName) Dim shapeList As SegmentClass Set shapeList = New SegmentClass With shapeList .Add drawFrame .Add drawBars .Add drawGrids .Add drawTitle .Group myName End With Set shapeList = Nothing End Sub '----- 枠線の描画 Private Function drawFrame() As String Dim frame drawFrame = "frame" Set frame = 枠を描画 frame.name = drawFrame End Function '----- すべてのグラフ線の描画 Private Function drawBars() As String Dim shapeList As SegmentClass Set shapeList = New SegmentClass drawBars = "Lines" With shapeList .Add drawBar(1) .Add drawBar(2) '・・・・ .Group drawBars End With Set shapeList = Nothing End Function '----- グラフ線一個分の描画 Private Function drawBar(index As Long) As String Dim bar 'index によって、グラフ化する値、グラフのスタイルが指定される drawBar = "line-" & index Set bar = グラフの線を描画(index) bar.name = drawBar End Function '----- 目盛り線の描画 Private Function drawGrids() As String Dim shapeList As SegmentClass Set shapeList = New SegmentClass drawGrids = "Grid" With shapeList .Add X軸目盛り線を描画 .Add X軸目盛り文字を描画 .Add Y軸目盛り線を描画 .Add Y軸目盛り文字を描画 .Group drawGrids End With Set shapeList = Nothing End Function '----- 表題の描画 Private Function drawTitle() As String Dim title drawTitle = "title" Set title = 表題を描画 title.name = drawTitle End Function
実際に、50個ほどのグラフを逐次左上に作成し、完成したものを所定の位置に再配置して、次のような一覧を作成しました。この内容自体は重要ではないのですが、右に「図形の書式 > オブジェクトの選択と表示」でオブジェクトの構成を表示したものを掲げておきました。
たとえば、「栄町」のグループは「栄町-title」「栄町-Grid」「栄町female」「栄町male」「栄町-frame」で構成されていて、さらに「栄町-Grid」は4つのグループで、「栄町female」と「栄町male」はそれぞれ4個のオブジェクトで構成されているのがわかります。