OK矢印複数ver

Sub ConnectShapesWithElbowArrow()

    Dim LastShape As Shape

    Dim Connector As Shape

    Dim i As Integer

    If ActiveWindow.Selection.Type <> ppSelectionShapes Then

        MsgBox "2つ以上の図形を選択してください。", vbExclamation

        Exit Sub

    End If

    If ActiveWindow.Selection.ShapeRange.Count < 2 Then

        MsgBox "2つ以上の図形を選択してください。", vbExclamation

        Exit Sub

    End If

    Set LastShape = ActiveWindow.Selection.ShapeRange(ActiveWindow.Selection.ShapeRange.Count)

    For i = 1 To ActiveWindow.Selection.ShapeRange.Count - 1

        Set Connector = ActiveWindow.Selection.SlideRange.Shapes.AddConnector(Type:=msoConnectorElbow, BeginX:=0, BeginY:=0, EndX:=100, EndY:=100)

        With Connector.Line

            .EndArrowheadStyle = msoArrowheadTriangle

            .ForeColor.RGB = RGB(192, 192, 192)

        End With

        Connector.ConnectorFormat.BeginConnect ConnectedShape:=ActiveWindow.Selection.ShapeRange(i), ConnectionSite:=1

        Connector.ConnectorFormat.EndConnect ConnectedShape:=LastShape, ConnectionSite:=1

        Connector.RerouteConnections

    Next i

End Sub