Making MS Word a Decent Text Editor
Submitted by reagle on Thu, 05/07/2009 - 13:02.
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
