コネクタ変更

コネクタ変更

Option Explicit

 

Sub コネクタの変更_直線()
If Not hasShapeRange(Selection) Then Beep: Exit Sub
changeConnectorType Selection.ShapeRange, msoConnectorStraight
End Sub

 

 

Sub コネクタの変更_カギ線()
If Not hasShapeRange(Selection) Then Beep: Exit Sub
changeConnectorType Selection.ShapeRange, msoConnectorElbow
End Sub

 

 

Sub コネクタの変更_曲線()
If Not hasShapeRange(Selection) Then Beep: Exit Sub
changeConnectorType Selection.ShapeRange, msoConnectorCurve
End Sub

 

Private Sub changeConnectorType(ByVal shps As Object, connectorType As MsoConnectorType)
Dim shp As Shape
For Each shp In shps
If shp.Connector Then
shp.ConnectorFormat.Type = connectorType
End If
Next
End Sub

 

Private Function hasShapeRange(ByVal obj As Object) As Boolean
On Error Resume Next
Dim shr As ShapeRange
Set shr = obj.ShapeRange
hasShapeRange = Not shr Is Nothing
Err.Clear
End Function