How to weld all shapes in shaperange into one

How to weld all shapes in shaperange into one

  • Select shapes then.

    or are you looking for macro code?

    • yes macro code

      • Hello,
        Please 
        Here is my macro.
        Enjoi!

        Sub BhBp_Weld()
        Dim OrigSelection As ShapeRange
        Set OrigSelection = ActiveSelectionRange
        If OrigSelection.Shapes.Count > 0 Then
        Dim BhBp_objects() As Shape
        ReDim BhBp_objects(1 To OrigSelection.Shapes.Count)

        Dim X As Integer

        For X = 1 To OrigSelection.Shapes.Count
        ' Create a unique variable name for each shape
        Set BhBp_objects(X) = OrigSelection.Shapes(X)
        Next X

        ' Now you can access the shapes using the BhBp_objects array
        For X = 1 To UBound(BhBp_objects) 'LBound
        Set BhBp_objects(1) = BhBp_objects(1).Weld(BhBp_objects(X), False, False)
        Next X
        Else
        MsgBox "No Shapes selected"
        End If
        End Sub

        Greetings!

        If you wish, you can support me HERE
        Thanks!