Sub CombineOpenPaths_Close2() Dim doc As Document Set doc = ActiveDocument Dim sel As ShapeRange Set sel = ActiveSelectionRange If sel.Count < 2 Then MsgBox "Please select at least two open paths." Exit Sub End If Dim i As Integer Dim combinedShape As shape ' Combine paths For i = 1 To sel.Count - 1 Step 2 If Not sel(i) Is Nothing And Not sel(i + 1) Is Nothing Then If sel(i).Type = cdrCurveShape And sel(i + 1).Type = cdrCurveShape Then ' Weld the two shapes sel(i).Weld sel(i + 1) End If End If Next i ' After welding, we need to refresh the selection Set sel = ActiveSelectionRange ' Close the paths by extending the lines End Subplease implement this ' Close the paths by extending the lines