Código:
Sub EliminarEspaciosSaltosDeLinea()
Dim F As Shape, C As textRange, T As String
If Not ActiveWindow.Selection.Type = ppSelectionShapes Then
MsgBox "Selecciona un cuadro de texto.", vbInformation
Exit Sub
End If
Set F = ActiveWindow.Selection.ShapeRange(1)
If Not F.HasTextFrame Then
MsgBox "Selecciona un cuadro de texto.", vbInformation
Exit Sub
End If
Set C = F.TextFrame.textRange
C.Text = Replace(C.Text, Chr(13), " ")
T = ""
For I = 1 To Len(C.Text)
If Not Mid(C.Text, I, 1) = " " Then
T = T & Mid(C.Text, I, 1)
ElseIf Not Mid(C.Text, I + 1, 1) = " " Then
T = T & Mid(C.Text, I, 1)
End If
Next I
C.Text = T
C.ParagraphFormat.Alignment = ppAlignJustify
End Sub