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

' 選択した２本のコネクタが直行する場合、水平線の直行部分を
' 円弧（半円）に自動編集する。
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

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

    ' 選択された二つのオートシェイプについて、それが水平線か垂直線か確認。
    ' 垂直線の場合は「Ｖ」、水平線の場合は「Ｈ」とする。
    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

    ' 選択した２本の線について、確認時用のエラーメッセージを準備。
    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
    ' 円弧の描画開始角度。ＸＹ座標の場合、原点から見て左（負）側。
    ' 変更したい場合、ここで編集。
    BeginAngle = 180
End Property

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

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

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


'［戻り値］
'   0   異常なし
'   ShapeTypeError  （=1）  エラー：選択したオートシェイプがコネクタではない｡
'   ShapeTypeError  （=2）  エラー：垂直線Ｖが垂直ではない（傾いている）。
'   ShapeTypeError  （=3）  エラー：水平線Ｈが水平ではない（傾いている）。
'   ShapeTypeError  （=4）  エラー：１～３以外のエラー。「不明（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

    ' 水平線Ｈが垂直線Ｖと交差していない場合、水平線のみ延長する。
    ' のちに円弧右側の水平線を描画する際、エラーにならないために。
    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

    ' 原点座標と半径から、円弧を描画するために必要な４つのパラメータを計算｡
    ' ＸＹ座標との関係は以下の通り。
    ' （Left, Top) = （0, ｒ）
    ' 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()

    ' 円弧の左側に、新たなコネクタを描画。
    ' コネクタ始端が円弧の終端に、コネクタ終端が水平線Ｈの終端と一致するように描画する｡
    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_Splited_Right.Line.Weight = H.Line.Weight
        H_Splited_Right.Line.ForeColor = H.Line.ForeColor

    ' 水平線Ｈは、円弧で分割されたように見える線分のうち、長さを縮めて左側の線とする｡
    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