Inserting a return after each character

So my logic is to have a button the when pressed will loop through each character and place a carriage return.   Ive add the returns but the only happen at the end not after each character.

Dim txt As String, s As Shape, i as integer

If s.Type = cdrTextShape Then

                 txt = ActiveShape.Text.Story.Text

               ' go through each character in the text (t)
          For i = 1 To Len(txt)
                 ActiveShape.Text.Story.InsertAfter (Chr(13))
          Next i

        End If