ワークシート上に少し複雑な画像を描くとします。たとえば、下のようなグラフ。いろいろな 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 CreateGraphDemo("NewGraph") で、NewGraph という名前のグループが作成されます。その中には、枠線、グラフの線、目盛り線、表題が含まれていて、グラフの線と目盛り線はさらに下位のグループを含んでいます。
標準モジュール CreateGraphDemo()
'----- 各パーツを描画して、全体をグループ化する
Public Sub CreateGraphDemo(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個のオブジェクトで構成されているのがわかります。
