LineZoom.bas

CDR11記念の第1弾は、ドキュメント内(現在のページ)の全てのShapeを検索して輪郭ペンの「イメージに合わせてスケール」属性をオンにするコードです。
全てのオブジェクトを選択していきなりこの属性を設定すると、輪郭がないオブジェクトまで輪郭がヘアラインで設定されてしまうため、輪郭を持つShapeに個別に設定する必要があります。(これこそ自動化の威力が発揮できるところですね。)
そこで、全てのオブジェクトを検索するコードが必要になります。
ShapeはShapeコレクションを持つことができ、グループ化とは対象のShapesをコレクションとするShapeです。ですから、実際の属性設定の対象となるShapeであるかどうか判定し、グループであれば更に下位を探しに行くという(ファイル検索と同じ)再帰呼び出しによる探索です。
mainはその最初の部分で、再帰での検索をShapeSearchが行い、最下位の(Groupでない)Shapeに対して属性を設定するsetpropを呼び出します。
今回はたまたま輪郭のスケール属性のみですが、このsetpropのコードを修正すれば、色々な用途に使えると思います。

---

Option Explicit
Sub Main()
Dim s As Shape
On Error Resume Next
If ActiveDocument Is Nothing Then
    MsgBox "ドキュメントがありません", vbCritical, "Error"
End If
For Each s In ActiveDocument.ActivePage.Shapes
    ShapeSearch s
Next s
End Sub

Sub ShapeSearch(ps As Shape)
Dim s As Shape
For Each s In ps.Shapes
    If s.Type = cdrGroupShape Then
        ShapeSearch s
    Else
        setprop s
    End If
Next s
End Sub

Sub setprop(os As Shape)
    If os.Outline.Type = cdrOutline Then
        os.Outline.ScaleWithShape = True
    End If
End Sub

---

＜＜戻る