VBscript for MS Word macro to re-shape transcripts that come in as plain text. Assumes speaker codes start each line and have a tab strike between speaker code and body of transcript. Will overwrite any existing file. Possibly useful for creating quick outlines of text formatted not already formatted as an outline.

transcriptShaper

Sub transcriptShaper()
'
' Verilogue Transcript Shaper Macro
' Author: cwoodford
'
'
    'Store the filename off
    Dim strName As String
    strName = ActiveDocument.Name
    
    'Select all and replace soft breaks with hard breaks
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^l"
        .Replacement.Text = "^p"
        .Forward = True
        
        'Skip the whole ask for confirmation part
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    'Change style to no spacing because otherwise it looks dumb
    Selection.Style = ActiveDocument.Styles("No Spacing")
    
    'Then set the paragraph styles and hanging indents
    With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(0.06)
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
    End With
    With Selection.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .FirstLineIndent = InchesToPoints(-0.06)
    End With
    With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(0.25)
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
    End With
    With Selection.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .FirstLineIndent = InchesToPoints(-0.25)
    End With
    With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(0.38)
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
    End With
    With Selection.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .FirstLineIndent = InchesToPoints(-0.38)
    End With
    With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(0.44)
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
    End With
    With Selection.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .FirstLineIndent = InchesToPoints(-0.44)
    End With
    With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(0.5)
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
    End With
    With Selection.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .FirstLineIndent = InchesToPoints(-0.5)
    End With
    With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(0.5)
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
    End With
    With Selection.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .FirstLineIndent = InchesToPoints(-0.5)
    End With
    
    'Save it to your desktop
    ChangeFileOpenDirectory "C:\Users\cwoodford\Desktop\"
    
    'Save with original filename in old school .DOC format
    ActiveDocument.SaveAs2 FileName:=strName, FileFormat:=wdFormatDocument, _
         LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, CompatibilityMode:=0
End Sub