Make Text in One Line

Sub CombineTextSingleLine()
    Dim srSelection As ShapeRange
    Dim strCombineText As String
    Dim s As Shape
    Dim i As Integer
    
    Set srSelection = ActiveSelectionRange
    If srSelection.Count < 1 Then MsgBox "Please select some text.", , "Combine Text to Single Line"
    
    If srSelection.Shapes.Count = 1 Then
        strCombineText = Replace(srSelection.FirstShape.Text.Story, Chr(10), "")
        strCombineText = Replace(strCombineText, Chr(13), " ")
    Else
        srSelection.Sort "@shape1.Top > @shape2.Top"
        
        For i = 1 To srSelection.Shapes.Count
            If i = 1 Then
                strCombineText = srSelection(i).Text.Story
            Else
                strCombineText = strCombineText & " " & srSelection(i).Text.Story
                srSelection(i).Delete
            End If
        Next i
    End If
    
    srSelection.FirstShape.Text.Story = strCombineText
End Sub