Making MS Word a Decent Text Editor

For editing prose, the Word application isn't so bad given there aren't that many select-and-say apps, but the binary format (.doc) is annoying; with simple text/markup it's easy to process, diff, keep under revision control, etc. So the following macros enable me to edit text documents without annoyance, and even make MarkDown and LaTeX files a little easier to look at.


Sub PasteUnformattedText() ' I prefer simple text pastes, bind to ctrl-v
    Selection.PasteSpecial DataType:=wdPasteText
End Sub
Sub FileSave()
' Yes, save it without formatting as Unicode, bind to ctrl-s
' flname = ActiveDocument.Name
' FileName:=flname,

FileName = ActiveDocument.FullName
Extension = Right(FileName, 3)
If Extension = "mdn" Or Extension = "txt" Then
    ActiveDocument.SaveAs FileFormat:=wdFormatUnicodeText, _
    Encoding:=65001, InsertLineBreaks:=False, AllowSubstitutions:= _
    False, LineEnding:=wdCRLF
Else
    ActiveDocument.Save
End If

End Sub

Sub AssociateStyle(pattern As String, style As String)
'Associate Styles with headings and quotations
'Ensure Tools/References/Microsoft VBscript Regular Expression 5.5 is on
  
Dim regEx, Match
Dim Matches As MatchCollection
Dim str As String
  
Set regEx = CreateObject("VBScript.RegExp")
regEx.pattern = pattern           ' Set pattern.
regEx.Global = True
regEx.Multiline = True

'obtain matched RegExp.
Set Matches = regEx.Execute(ActiveDocument.Range.Text)
'MsgBox (Matches.Count)
'loop through and replace style
For Each Match In Matches
    ActiveDocument.Range(Match.FirstIndex, Match.FirstIndex + Len(Match.Value)).style = _
    ActiveDocument.Styles(style)
Next
 
End Sub

Sub ReplaceMarkup(pattern As String, markup As String)
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = pattern
        .Replacement.Text = markup
        .Forward = True
        .Wrap = wdFindNo
        .format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

 
Sub AutoOpen()
'
' AutoOpen Macro
' Macro recorded 5/6/2009 by reagle
'
FileName = ActiveDocument.FullName
Extension = Right(FileName, 3)
If Extension = "mdn" Then
        Selection.WholeStory
        Selection.Font.Name = "Georgia"
        Selection.Font.Size = 12
        Selection.ParagraphFormat.LineSpacing = 16
        Selection.style = "Body Text"
        Call AssociateStyle("^% ", "Heading 1")
        Call AssociateStyle("^# ", "Heading 1")
        Call AssociateStyle("^## ", "Heading 2")
        Call AssociateStyle("^### ", "Heading 3")
        Call AssociateStyle("^> ", "Quote")
End If
If Extension = "tex" Then
        Selection.WholeStory
        Selection.Font.Name = "Georgia"
        Selection.Font.Size = 12
        Selection.ParagraphFormat.LineSpacing = 16
        Selection.style = "Body Text"
        'Call ReplaceMarkup("\\emph\{(*)\}", "<<\1>>")
        Call AssociateStyle("^\\title{", "Heading 1")
        Call AssociateStyle("^\\chapter{", "Heading 1")
        Call AssociateStyle("^\\section{", "Heading 1")
        Call AssociateStyle("^\\subsection{", "Heading 2")
        Call AssociateStyle("^\\subsubsection{", "Heading 3")
        Call AssociateStyle("^\\begin{quotation}", "Quote")
End If

End Sub





Syndicate content