Power Point(パワーポイント)VBAで、交差するコネクタの片方をアーチ型に自動編集する(マクロにコメント追加)

昨日はPower Point のVBAで、交差するコネクタの片方をアーチ型に自動編集するマクロを紹介しました。
infoment.hatenablog.com

昨日は時間が無かったため、何の説明もないまま、コードを載せるだけで終わっていました。
そこで今回コードに説明用コメントを追記したものを、改めてご紹介します。コメントを書きながら、ある勘違いに気づいた個所もあって、併せて修正しています。もしお使いになられる場合は、昨日ではなく今日のコードをご参照ください。


まず、今回最も重要な「円弧」を描くコード。これについては、こちらを参照しました。とても分かり易く紹介されています。この場を借りて、お礼申し上げます。
d.hatena.ne.jp

本題となるコードは、以下の通りです。一部のプロシージャについては、登場する順番どおりに記載位置を変えており、話の流れを理解しやすくしたつもりです。

[標準モジュール]

Option Explicit

' 選択済みオートシェイプ確認時のエラーの種類を数値化。
' エラーメッセージ(配列)のインデックスと対応している。
' 例)errMsg(ShapeTypeError) は、errMsg(1)になる。
Enum ErrorType
    ShapeTypeError = 1
    VerticalTiltError
    HolizontalTiltError
    UnidentifiedError
End Enum

' 選択した2本のコネクタが直行する場合、水平線の直行部分を
' 円弧(半円)に自動編集する。
Sub StepOver()

    ' オートシェイプの選択確認。
    ' 選択されていない場合エラーになるため、まず確認しておく。
    Dim ShapeRanges As ShapeRange
    On Error Resume Next
    Set ShapeRanges = ActiveWindow.Selection.ShapeRange
    If Err.Number = -2147188160 Then
        MsgBox "オートシェイプが選択されていません。"
        Exit Sub
    End If
    On Error GoTo 0

    ' 現状は2本のコネクタについてのみ対応。
    ' 条件が変われば、この部分も要変更。
    If ShapeRanges.Count <> 2 Then
        MsgBox "コネクタを2本選択したうえで、再度実行してください。"
        Exit Sub
    End If

    ' 選択された二つのオートシェイプについて、それが水平線か垂直線か確認。
    ' 垂直線の場合は「V」、水平線の場合は「H」とする。
    Dim shape As shape
    Dim SC As ShapeClass
    Set SC = New ShapeClass
        For Each shape In ShapeRanges
            If shape.Height > shape.Width Then
                Set SC.V = shape
            Else
                Set SC.H = shape
            End If
        Next

    ' 選択した2本の線について、確認時用のエラーメッセージを準備。
    Dim ErrMsg(4) As String
        ErrMsg(1) = "直線以外が選択されています。"
        ErrMsg(2) = "垂直線が傾いています。"
        ErrMsg(3) = "水平線が傾いています。"
        ErrMsg(4) = "エラー発生(直線以外が選択されている、など)。"


    ' チェックの結果が正しい場合、戻り値は「0」となる。
        If SC.Check <> 0 Then
            MsgBox ErrMsg(SC.Check)
            Exit Sub
        End If

    ' 円弧を描画。
        Call SC.DrawHalfArc

    ' 元からあった線は、分割(したように見える)左側の線となる。
    ' 実際は分割していないので、右側の線を新たに描画する。
        Call SC.AdjustLength

    ' 水平線と円弧の各端を接続する。
    ' 左右の線と円弧を一まとめで移動などさせたいので。
        Call SC.ConnectShape

End Sub


[クラスモジュール]名前:ShapeClass

Option Explicit

' 垂直線
Public V As shape
' 水平線
Public H As shape
' 編集後の線のうち、円弧の左側にある水平線
Public H_Splited_Left As shape
' 編集後の線のうち、円弧の右側にある水平線
Public H_Splited_Right As shape
' 円弧の半径
Public radius As Double
' 描画された円弧
Public HalfArc As shape

Private Sub Class_Initialize()
    ' 円弧の半径初期値
    ' ※インスタンス生成後、任意の値を指定可能。
    radius = 10
End Sub

Private Property Get BeginAngle() As Long
    ' 円弧の描画開始角度。XY座標の場合、原点から見て左(負)側。
    ' 変更したい場合、ここで編集。
    BeginAngle = 180
End Property

Private Property Get EndAngle() As Long
    ' 円弧の描画終了角度。XY座標の場合、原点から見て右(正)側。
    ' 変更したい場合、ここで編集。
    EndAngle = 0
End Property

Private Property Get origin_point_x() As Double
    ' 円弧の原点X座標。
    ' ※感覚的に、円(または円弧)は中心座標と半径で指定したい。
    origin_point_x = V.Left
End Property

Private Property Get origin_point_y() As Double
    ' 円弧の原点Y座標。
    ' ※感覚的に、円(または円弧)は中心座標と半径で指定したい。
    origin_point_y = H.Top
End Property


'[戻り値]
'   0   異常なし
'   ShapeTypeError  (=1)  エラー:選択したオートシェイプがコネクタではない。
'   ShapeTypeError  (=2)  エラー:垂直線Vが垂直ではない(傾いている)。
'   ShapeTypeError  (=3)  エラー:水平線Hが水平ではない(傾いている)。
'   ShapeTypeError  (=4)  エラー:1~3以外のエラー。「不明(Unidentify)」としているが、造り込めば細分化可能(と思います)。

Public Function Check() As Long

    On Error GoTo er:
    ' 「かぎ付きコネクタ」も対応させたい場合、この部分の修正が必要。
    If Not V.Name Like "Straight Connector*" Then
        Check = ShapeTypeError
    ElseIf Not H.Name Like "Straight Connector*" Then
        Check = ShapeTypeError
    ElseIf V.Width > 0 Then
        Check = VerticalTiltError
    ElseIf H.Height > 0 Then
        Check = HolizontalTiltError
    Else
        Check = 0
    End If

    ' 水平線Hが垂直線Vと交差していない場合、水平線のみ延長する。
    ' のちに円弧右側の水平線を描画する際、エラーにならないために。
    If H.Left + H.Width < V.Left Then
        H.Width = V.Left + 2 * radius + 30 - H.Left
    End If

    Exit Function

er:
    Check = UnidentifiedError

End Function


'[戻り値]
'   True    描画成功
'   False   描画失敗

Public Function DrawHalfArc() As Boolean

    ' 原点座標と半径から、円弧を描画するために必要な4つのパラメータを計算。
    ' XY座標との関係は以下の通り。
    ' (Left, Top) = (0, r)
    ' Width = Hight = r
    Dim myLeft As Double:   myLeft = origin_point_x
    Dim myTop As Double:    myTop = origin_point_y - radius
    Dim myWidth As Double:  myWidth = radius
    Dim myHeight As Double: myHeight = radius

    Dim Arc As shape
    On Error GoTo er:
    ' まず円を描画。
    Set Arc = ActivePresentation.Slides(ActiveWindow.Selection.SlideRange.SlideIndex).Shapes. _
              AddShape(msoShapeArc, _
                       myLeft, _
                       myTop, _
                       myWidth, _
                       myHeight)

        ' 開始角と終了角を指定して、上側のみの半円にする。
        Arc.Adjustments.Item(1) = BeginAngle
        Arc.Adjustments.Item(2) = EndAngle

    Set HalfArc = Arc

    DrawHalfArc = True

    Exit Function

er:

    DrawHalfArc = False

End Function

Public Sub AdjustLength()

    ' 円弧の左側に、新たなコネクタを描画。
    ' コネクタ始端が円弧の終端に、コネクタ終端が水平線Hの終端と一致するように描画する。
    Set H_Splited_Right = ActivePresentation.Slides(ActiveWindow.Selection.SlideRange.SlideIndex).Shapes. _
                            AddConnector(msoConnectorStraight, _
                                     origin_point_x + radius * 2, _
                                     H.Top, _
                                     H.Left + H.Width, _
                                     H.Top)

        ' 色と太さを、元の水平線Hに揃える。
        H_Splited_Right.Line.Weight = H.Line.Weight
        H_Splited_Right.Line.ForeColor = H.Line.ForeColor

    ' 水平線Hは、円弧で分割されたように見える線分のうち、長さを縮めて左側の線とする。
    Set H_Splited_Left = H
        H_Splited_Left.Width = origin_point_x - radius * 2 - H_Splited_Left.Left

End Sub

Public Sub ConnectShape()

    ' 左側の水平線終端と、円弧の始端を接続する。
    H_Splited_Left.ConnectorFormat.EndConnect HalfArc, 1
    ' 右側の水平線始端と、円弧の終端を接続する。
    H_Splited_Right.ConnectorFormat.BeginConnect HalfArc, 3

End Sub

勘違いしていたのは、円弧のパラメータが示す位置とサイズです。その結果、指定した半径の2倍の円弧を描画していました。

今回は良かれと思い、二つの直線が交差していない場合も、水平線を伸ばして円弧を描くようにしています。
f:id:Infoment:20180908172413p:plainf:id:Infoment:20180908172458p:plain

しかし実際、複数のコネクタがある中で「勝手に」伸ばすと、思わぬ誤動作に繋がる恐れがあります。今後の作りこみにて、この辺りも改良できればと思います。

参考まで。