Power Point（パワーポイント）VBAで、交差するコネクタの片方をアーチ型に自動編集する

今まで使ったことが無かったのですが、Power Point にもVBAがあります。2018年9月現在、その使用方法について↓こちらで連載が始まっています。大変分かり易く、目が離せません。
tonari-it.com

これらの連載記事を参考に、日頃不便に思っていたことの自動化に挑戦しました。こんな感じで。

Power Point でフローチャートなどを書く時、線が交差していると、とても見にくく感じます。

f:id:Infoment:20180907183528p:plain

そこで、水平線に垂直線をアーチ形状で跨がせるマクロを作成してみました。

［標準モジュール］

Option Explicit

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) = "エラー発生（直線以外が選択されている、など）。"

        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 = 8
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

Public Function DrawHalfArc() As Boolean

    Dim myLeft As Double:   myLeft = origin_point_x
    Dim myTop As Double:    myTop = origin_point_y - radius * 2
    Dim myWidth As Double:  myWidth = radius * 2
    Dim myHeight As Double: myHeight = radius * 2

    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 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

Public Sub ConnectShape()
    H_Splited_Left.ConnectorFormat.EndConnect HalfArc, 1
    H_Splited_Right.ConnectorFormat.BeginConnect HalfArc, 3
End Sub