The Logic Museum:VBA

From The Logic Museum

Jump to: navigation, search

The VBA code below will allow you to use MS word to create Wiki code quickly. To assign a hot key to them, choose

Tools/Customise/Keyboard/Categories/Macros

Then select the macro you want, and press the hot key you want to use.

Const Wiki = 1

Sub wikitable()
Dim tablerows As Integer
FilePath = "C:\Users\edward\Website\"
OutputFile = FilePath & "temp.txt"
Open OutputFile For Output As #1


Print #1, "{| border=1 cellpadding=10"""
Print #1, "!valign = top width=45%|Latin"
Print #1, "!valign = top width=55%|English"

For Each Row In ActiveDocument.Tables(1).Rows
Print #1, "|- valign = top"
Print #1, "||", Row.Cells(1).Range, "||", Row.Cells(2).Range

Next
Print #1, "|}"
Close #1

End Sub


Sub TableToHtml()
Dim tablerows As Integer

' tablerows = ActiveDocument.Tables(1).Rows.Count

FilePath = "C:\Users\edward\Website\"


OutputFile = FilePath & "temp.htm"
Open OutputFile For Output As #1



' properties
Print #1, "<HTML> <HEAD> <title>TITLE HERE</title>"


Print #1, "<meta name=""Author"" content=""" & "AUTHOR" & """>"
Print #1, "<meta name=""keywords"" content=""" & "KEYWORDS" & """ > "


Print #1, "<meta http-equiv=Content-Type content=""text/html; charset=windows-1252"">" ' add other meta data stuff
Print #1, "<link href=""../../logicmuseum.css"" rel=""stylesheet"" type=""text/css"">"

Print #1, "</head>"
Print #1, "<body>"
Print #1, " <hr> <b><font size = ""+2"">" & "TITLE" & "</font></b> <hr>"

Print #1, "<br><br><br>"


Print #1, "<table border cellpadding = 10 span = 2 >"
Print #1, "<COL width=46% valign = top>"
Print #1, "<COL width=54% valign = top>"
Print #1, "<thead>"
Print #1, "<tr> <th>Latin</th><th>English</th>"
Print #1, "</tr> </thead> <tbody>"

For Each Row In ActiveDocument.Tables(1).Rows
Print #1, "<tr> <td>", Row.Cells(1).Range, "</td> <td>", Row.Cells(2).Range, "</td> </tr>"

Next

Print #1, "</tbody> </table> <br> <br> <br> <br> <br> <br> <br>"
Print #1, "<hr size=2 width=""100%"" align=center>"
Print #1, "</span></div>"
Print #1, "<p class=MsoNormal><span lang=EN-US style='font-family:Garamond'>"
Print #1, "<a href=""../index.htm"">THE LOGIC MUSEUM</a></span><span lang=EN-US style='mso-ansi-language: EN-GB '>"
Print #1, "</span><span lang=EN-US style='font-family:Garamond'>Copyright (html only) (C) E.D.Buckner 2010.</span><span style='mso-ansi-language:EN-GB'><o:p></o:p></span>"
Print #1, "<hr size=2 width=""100%"" align=center>"
Print #1, "</body> </html>" ' trailing html tags

Close #1

End Sub




Sub italics()
Dim strTemp As String

strTemp = Selection.Text

If Wiki = 1 Then
Selection.TypeText Text:="''" & strTemp & "''"
Else
Selection.TypeText Text:="<i>" & strTemp & "</i>"
End If
End Sub

Sub embolden()
Dim strTemp As String

strTemp = Selection.Text
If Wiki = 1 Then
Selection.TypeText Text:="'''" & strTemp & "'''"
Else
Selection.TypeText Text:="<b>" & strTemp & "</b>"
End If
End Sub

Sub addlink()
Dim strTemp As String

strTemp = Selection.Text

If Wiki = 1 Then
Selection.TypeText Text:="["
Selection.Paste
Selection.TypeText " " & strTemp & "]"
Else
Selection.TypeText Text:="<a href = " & """"
Selection.Paste
Selection.TypeText """>" & strTemp & "</a>"
End If


End Sub

Sub addpicture()
Dim strTemp As String

strTemp = Selection.Text
Selection.TypeText Text:="<img align=""right"" height=""180px"" src=""http://www.logicmuseum.com/pictures/"
Selection.Paste
Selection.TypeText strTemp & """ />"
End Sub

Sub addanchor()

If Wiki = 1 Then
Selection.TypeText Text:="<div id=" & """"
Selection.PasteSpecial DataType:=2
Selection.TypeText """" & "></div>"
Else
Selection.TypeText Text:="<a name = " & """"
Selection.PasteSpecial DataType:=2
Selection.TypeText """" & "></a>"
End If

End Sub

Sub addreference()
Dim strTemp As String

' strTemp = Selection.Text

If Wiki = 1 Then
' Selection.TypeText Text:="<ref>" & strTemp & "</ref>"
Selection.TypeText Text:="<ref>"
Selection.PasteSpecial DataType:=2
Selection.TypeText "</ref>"
Else
Selection.TypeText Text:="<i>" & strTemp & "</i>"
End If
End Sub

Sub blockquote()
Dim strTemp As String

strTemp = Selection.Text
Selection.TypeText Text:="<blockquote>" & strTemp & "</blockquote>"

End Sub


Sub carriagereturn()
Selection.TypeText Text:="<br>"

End Sub

Sub para()
Selection.TypeText Text:="<p></p>"
End Sub


Sub replaceall()
' t = textreplace("siue", "sive")
t = textreplace(" uel", " vel")
t = textreplace("uniuer", "univer")
t = textreplace(" uero", " vero")
t = textreplace("iuu", "ivu")
t = textreplace(" ual", " val")
t = textreplace(" uar", " var")
t = textreplace("auis", "avis")
t = textreplace("auit", "avit")
t = textreplace(" uid", " vid")
t = textreplace("breui", "brevi")
t = textreplace("leui", "levi")
t = textreplace("oui", "ovi")
t = textreplace("eui", "evi")
t = textreplace("ciui", "civi")
t = textreplace(" uen", " ven")
t = textreplace("oue", "ove")
t = textreplace("iui", "ivi")
t = textreplace("ueni", "veni")
t = textreplace(" uer", " ver")
t = textreplace("iuo", "ivo")
t = textreplace("aui", "avi")
t = textreplace("serua", "serva")
t = textreplace(" ui", " vi")
t = textreplace("inue", "inve")
t = textreplace("adue", "adve")
t = textreplace("iua", "iva")
t = textreplace("iue", "ive")
t = textreplace("solui", "solvi")
t = textreplace(" uo", " vo")
t = textreplace("priua", "priva")
t = textreplace("solua", "solva")
t = textreplace("conue", "conve")
t = textreplace("aue", "ave")
t = textreplace("quamuis", "quamvis")
t = textreplace("inuicem", "invicem")

End Sub

Sub removecorpusthomisticumID()
t = textreplace("<tr> <td> [^#^#^#^#^#] ^p</td> <td> ^p</td> </tr>", "")
End Sub


Function textreplace(sourcetext, destext)
'
' Macro1 Macro
' Macro recorded 09/09/2006 by edward buckner
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = sourcetext
.Replacement.Text = destext
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Function

Function newtextreplace(sourcetext, destext, wholeword As Boolean)
'
' Macro1 Macro
' Macro recorded 09/09/2006 by edward buckner
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = sourcetext
.Replacement.Text = destext
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = wholeword
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Function



Sub replacesquarebrackets()
t = textreplace("] Sentent", " Sentent")
t = textreplace("0 Sentent", " Sentent")
t = textreplace("1 Sentent", " Sentent")
t = textreplace("2 Sentent", " Sentent")
t = textreplace("3 Sentent", " Sentent")
t = textreplace("4 Sentent", " Sentent")
t = textreplace("5 Sentent", " Sentent")
t = textreplace("6 Sentent", " Sentent")
t = textreplace("7 Sentent", " Sentent")
t = textreplace("8 Sentent", " Sentent")
t = textreplace("9 Sentent", " Sentent")
t = textreplace("[ Sentent", " Sentent")
End Sub


Sub convert_to_mwb()
t = textreplace("<table rules = groups>", "")
t = textreplace("<table border cellpadding = 10 span = 2>", "{| border=1 cellpadding=10")
t = textreplace("<table border cellpadding = 10 span = 2 >", "{| border=1 cellpadding=10")
t = textreplace(" valign = top>", "|Latin")
t = textreplace("<COL width=", "!valign = top width=")
t = textreplace("<thead>", "")
t = textreplace("</thead>", "")
t = textreplace("<tbody>", "")

t = textreplace("<tr> <th>Latin</th><th>English</th>", "")
t = textreplace("</tr> </thead> <tbody>", "")
t = textreplace("<tr> <td> Latin", "")
t = textreplace("</td> <td> English", "")
t = textreplace("</tbody>", "")
t = textreplace("^p^p", "^p")
t = textreplace("^p^p", "^p")
t = textreplace("^p^p", "^p")

t = textreplace("<tr>", "|- valign = top^p")
t = textreplace("<td>", "^p||")
t = textreplace("</td>", "")
t = textreplace("</tr>", "")
t = textreplace("</table>", "|}")
t = textreplace("<p>^p", "")
t = textreplace("</p>^p", "")
t = textreplace("<p>", "")
t = textreplace("</p>", "")

' <a href = "
' t = textreplace("<a name=", "<div id=")
t = textreplace("<a name=", "<div id=")
t = textreplace("<a name = ", "<div id=")
' t = textreplace("<div id=", "||<div id=") 'COMMENTED OUT - LEAVE IN
t = textreplace("</a>", "")
t = textreplace(""">||", """>")
't = textreplace("<a href=""", "[[")
t = textreplace("<a href = """, "[[")
t = textreplace("<a href=""", "[[") ' in case no spaces
' t = textreplace("<a href=""#", "*[[#")
t = textreplace("<a href=#", "*[[#")

'---------------------- ADDITIONAL PROJECT SPECIFIC
't = textreplace("[[#", "*[[#")
't = textreplace("<br>", "")
' t = textreplace("<p>", "")
' t = textreplace("<br>", "]]")

' t = textreplace(""">Q", "|Q")
' t = textreplace(">Q", "|Q")

' t = textreplace("</font></b>", "")
' t = textreplace("<hr>", "----------------- [[Directory:Logic Museum/Aquinas Summa Theologiae|Index]]")
t = textreplace("|}", "|^p} [[Category:Logic Museum Parallel Texts]]")
correctquotes
End Sub

Sub AAMwb()
t = textreplace("|- valign = top", "^p|- valign = top^p")
t = textreplace("<b></b>", "")

End Sub

Sub RemoveTextBox2()
Dim shp As Shape
Dim oRngAnchor As Range
Dim sString As String

For Each shp In ActiveDocument.Shapes
If shp.Type = msoTextBox Then
' copy text to string, without last paragraph mark
sString = Left(shp.TextFrame.TextRange.Text, _
shp.TextFrame.TextRange.Characters.Count - 1)
If Len(sString) > 0 Then
' set the range to insert the text
Set oRngAnchor = shp.Anchor.Paragraphs(1).Range
' insert the textbox text before the range object
oRngAnchor.InsertBefore _
"Textbox start << " & sString & " >> Textbox end"
End If
shp.Delete
End If
Next shp
End Sub

Sub addbekker()
strTemp = Selection.Text
strTempTrimmed = Replace(strTemp, " ", "")

If Wiki = 1 Then
Else
Selection.TypeText Text:="<a href=""../../aristotle/physics/physics.htm#bk" & strTempTrimmed & """>" & strTemp & "</a>"
End If

End Sub
Sub HtmlToTable()
t = textreplace("<tr>", "<br>")
t = textreplace("^p", "")
t = textreplace("<td>", "|")
t = textreplace("</td>", "")
t = textreplace("</tr>", "")
t = textreplace("<br>", "^p")
'Exit Sub
Selection.WholeStory
Selection.ConvertToTable Separator:=wdSeparateByDefaultListSeparator, _
NumColumns:=3, NumRows:=11, AutoFitBehavior:=wdAutoFitFixed
With Selection.Tables(1)
.Style = "Table Grid"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
Selection.HomeKey Unit:=wdStory

Selection.SelectColumn
Selection.Columns.Delete
End Sub

Sub RossRemove()
t = textreplace("^l", " ")
t = textreplace("<p", "^l^l<p")

t = textreplace(" ", " ")
t = textreplace(" ", " ")

t = textreplace("<b style='mso-bidi-font-weight:normal'>", "<b>")
t = textreplace("<b style='mso-bidi-font-weight: normal'>", "<b>")

t = textreplace("<span lang=EN-US>", "")
' t = textreplace("<span lang=PT-BR style='mso-ansi-language: PT-BR'>", "")
t = textreplace("<span lang=PT-BR style='mso-ansi-language:PT-BR'>", "")
t = textreplace("<span lang=PT-BR style='mso-ansi-language: PT-BR'>", "")

t = textreplace("</span>", "")
t = textreplace("<span style='mso-spacerun:yes'>", "")

t = textreplace("<p class=MsoNormal>", "<p>")
t = textreplace("<p><o:p> </o:p></p>", "")
t = textreplace("<b^lstyle='mso-bidi-font-weight:normal'>", "<b>")
t = textreplace("<o:p></o:p>", "")
t = textreplace("^l^l^l", "^l^l")
t = textreplace("^l^l^l", "^l^l")
t = textreplace("^l^l", "^l")


End Sub

Sub TidyLatinScan()
t = textreplace("tcr ", "ter ")
t = textreplace("s i dic", "si dic")
t = textreplace("cx", "ex")
t = textreplace("fcct", "fect")
t = textreplace("quc", "que")
t = textreplace("quac", "quae")
' t = textreplace("ctc", "ect")
t = textreplace("pct", "pet")

t = WordReplace("pcr", "per")
t = WordReplace("sc", "se")
t = WordReplace("idco", "ideo")

End Sub

Function WordReplace(oldword As String, newword As String)
With Selection.Find
.Text = oldword
.Replacement.Text = newword
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Function


Sub buildtable()
Selection.TypeText Text:="<table border = 1><colgroup><col valign=top width=50%><colgroup><col valign=top width=50%><thead><tr><th>Latin</th><th>English</th></tr></thead><tbody><tr><td>LATIN HERE</td><td>ENGLISH HERE</td></tr>"
End Sub

Sub blogtable()
Selection.TypeText Text:="<table border=""1""><colgroup><col valign=""top"" width=""44%""><col valign=""top"" width=""56%""></colgroup><thead><tr><th>Latin</th><th>English</th></tr></thead><tbody><tr><td></td><td></td></tr></tbody></table>"
End Sub

Sub correctquotes()
Options.AutoFormatAsYouTypeReplaceQuotes = False
t = WordReplace("""", """")
Options.AutoFormatAsYouTypeReplaceQuotes = True
End Sub

Sub toptable()
t = WordReplace("|- valign = top^p", "")
t = WordReplace("||[[#", "*[[#")
t = WordReplace(""">", "|")
t = WordReplace("||^#.^#^#", "]] ")
t = WordReplace("||^#.^#", "]] ")
t = WordReplace("||^#^#.^#^#", "]] ")
t = WordReplace("||^#^#.^#", "]] ")
t = WordReplace("||", " ")

End Sub

Sub TableToWiki()
Dim Wiki As Integer, Draft As Integer, DraftOpen As String, FontClose As String, Font As String
Set SourceDoc = ActiveDocument
Wiki = 1
Draft = 0

If Draft = 1 Then
' DraftOpen = "<span style=""font-family: courier new"">"
' DraftOpen = "<span style=""background-color: #ccffcc"">"
Font = "<span style=""font-family: verdana"">"
DraftOpen = "<span style=""background-color: #ccffcc"">"
FontClose = "</span>"
Else
DraftOpen = ""
DraftClose = ""
End If

Documents.Add DocumentType:=wdNewBlankDocument
Set DestinationDoc = ActiveDocument
If Wiki = 1 Then

Selection.TypeText "{| border=1 cellpadding=10" & Chr(11)
Selection.TypeText "!valign = top width=45%|Latin" & Chr(11)
Selection.TypeText "!valign = top width=55%|English" & Chr(11)

For Each Row In SourceDoc.Tables(1).Rows
Selection.TypeText "|- valign = top" & Chr(11)
Selection.TypeText "|" & Font & Left(Row.Cells(1).Range, Len(Row.Cells(1).Range) - 1) & FontClose & Chr(11) & "|" & DraftOpen & Font & Left(Row.Cells(2).Range, Len(Row.Cells(2).Range) - 1) & FontClose & FontClose & Chr(11)

Next
Selection.TypeText "|}"
Selection.TypeText Chr(11) & "==Notes==" & Chr(11) & "{{reflist}}"

Selection.TypeText "[[Category:Unchecked scans]]"
' Selection.TypeText "|" & Chr(11) & "}" ' we fixed this problem


Else
' Selection.TypeText Text:="asdasd"


Selection.TypeText "<table border cellpadding = 10 span = 2 >" & Chr(11)

Selection.TypeText "<COL width=46% valign = top>" & Chr(11)
Selection.TypeText "<COL width=54% valign = top>" & Chr(11)
Selection.TypeText "<thead>" & Chr(11)
Selection.TypeText "<tr> <th>Latin</th><th>English</th>" & Chr(11)
Selection.TypeText "</tr> </thead> <tbody>" & Chr(11)

For Each Row In SourceDoc.Tables(1).Rows
Selection.TypeText "<tr> <td>" & Left(Row.Cells(1).Range, Len(Row.Cells(1).Range) - 1) & "</td> <td>" & Left(Row.Cells(2).Range, Len(Row.Cells(2).Range) - 1) & "</td> </tr>" & Chr(11)
Next

Selection.TypeText "</tbody> </table> " & Chr(11)

End If

End Sub

Sub WikiToTable()
t = textreplace("|- valign = top", "<tr>")
t = textreplace("|- valign=""top""", "<tr>")
t = textreplace("||", "^p|") 'all inline pipes converted to newline pipes
t = textreplace("^p|", "<td>") ' all newline pipes converted to unambiguous separator
t = textreplace("^p", "")
t = textreplace("<tr>", "^p")
t = textreplace("^p<td>", "^p")
t = textreplace("|", "<pipe>") 'all genuine pipes converted to unambiguous sign
t = textreplace("<td>", "|") 'all cell pipes converted to pipe sign

Selection.WholeStory
Selection.ConvertToTable Separator:=wdSeparateByDefaultListSeparator, _
NumColumns:=3, NumRows:=11, AutoFitBehavior:=wdAutoFitFixed
With Selection.Tables(1)
.Style = "Table Grid"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
Selection.HomeKey Unit:=wdStory

t = textreplace("<pipe>", "|") 'convert back to pipe sign

End Sub


Sub cleanspellings()
t = newtextreplace("formac", "formae", True)
t = newtextreplace("illc", "ille", True)
t = newtextreplace("rcs", "res", False)
t = newtextreplace("eriam", "etiam", True)
t = newtextreplace("sinc", "sine", True)
t = newtextreplace("bcat", "beat", False)
t = newtextreplace("erc ", "ere ", False)
t = newtextreplace("rcsp", "resp", False)
t = newtextreplace("pcc", "pec", False)
t = newtextreplace("nctc", "ncte", False)
t = newtextreplace("expcr", "exper", False)
t = newtextreplace("ctc", "etc", True)
t = newtextreplace("scicn", "scien", False)
t = newtextreplace("fmis", "finis", True)
t = newtextreplace("supcr", "super", False)
t = newtextreplace("undc", "unde", False)
t = newtextreplace("dcre", "dere", False)
t = newtextreplace("crcat", "creat", False)
t = newtextreplace("codem", "eodem", True)
t = newtextreplace("ctiam", "etiam", True)
t = newtextreplace("mcdi", "medi", False)
t = newtextreplace("neccss", "necess", False)
t = newtextreplace("rcq", "req", False)
t = newtextreplace("ncm", "nem", False)
t = newtextreplace(" cv", " ev", False)
t = newtextreplace("tct", "tet", False)
t = newtextreplace("crgo", "ergo", False)
t = newtextreplace("fortc", "forte", True)
t = newtextreplace("csse", "esse", True)
t = newtextreplace("essc", "esse", True)
t = newtextreplace("sct", "set", False)
t = newtextreplace("rcn", "ren", False)
t = newtextreplace("sivc", "sive", True)
t = newtextreplace("scihcet", "scilicet", False)
t = newtextreplace("tcs", "tes", False)
t = newtextreplace("tcl", "tel", False)
t = newtextreplace(" dc", " de", False)
t = newtextreplace("oht", "olit", False)
t = newtextreplace("conecdo", "concedo", False)
t = newtextreplace("fcr", "fer", False)
t = newtextreplace("irc ", "ire ", False)
t = newtextreplace("ncn", "nen", False)
t = newtextreplace("crit", "erit", True)
t = newtextreplace("dcb", "deb", False)
t = newtextreplace("rc", "re", True)
t = newtextreplace("lhg", "llig", False)
t = newtextreplace("bcr", "bcr", False)
t = newtextreplace("qttod", "quod", False)
t = newtextreplace("conecptus", "conceptus", False)
t = newtextreplace("scn", "sen", False)
t = newtextreplace("quaeumque", "quacumque", False)
t = newtextreplace("pcrs", "pers", False)
t = newtextreplace("ncs", "ncs", False)
t = newtextreplace("aht", "alit", False)
'Exit Sub
t = newtextreplace("$", "S", False)
t = newtextreplace("lcs", "les", False)
t = newtextreplace("scm", "sem", False)
t = newtextreplace("ncg", "neg", False)
t = newtextreplace("tahs", "tahs", True)
t = newtextreplace("tuni ", "tum ", False)
t = newtextreplace("tcn", "ten", False)
t = newtextreplace("gcn", "gen", False)
t = newtextreplace("tcm", "tem", False)
t = newtextreplace("spccie", "specie", False)
t = newtextreplace("scilicct", "scilicet", True)
t = newtextreplace("ncc", "nec", False)
t = newtextreplace("bihs", "bilis", False)
t = newtextreplace("propric", "proprie", True)
t = newtextreplace("ncc", "nec", True)
t = newtextreplace("omnc", "omne", True)
t = newtextreplace("istc", "iste", True)
t = newtextreplace("itcm", "item", True)
t = newtextreplace("hacc", "haec", True)
t = newtextreplace("subicct", "subiect", False)
t = newtextreplace("talc", "tale", True)
t = newtextreplace("bct", "bet", False)
t = newtextreplace("rcm", "rem", False)
t = newtextreplace("practer", "praeter", True)
t = newtextreplace("lcm", "lem", False)
t = newtextreplace("erct", "eret", False)
t = newtextreplace("patct", "patet", True)
t = newtextreplace("sciJicet", "scilicet", True)
t = newtextreplace("cff", "eff", False)
t = newtextreplace("ciusdem", "eiusdem", True)
t = newtextreplace("dcm", "dem", False)
t = newtextreplace("prc", "pre", False)
t = newtextreplace("dci", "dei", False)
t = newtextreplace("pracdic", "praedic", False)
t = newtextreplace("scqu", "sequ", False)
t = newtextreplace("specic", "specie", True)
t = newtextreplace("ciusdem", "eiusdem", True)
t = textreplace("vidct", "videt")
t = textreplace("autcm", "autem")
t = textreplace("vcl", "vel")
t = textreplace("rcal", "real")
t = newtextreplace("rcm", "real", True)
t = newtextreplace("illnd", "illud", True)
End Sub

Sub nowikipipe()
t = textreplace("|§", "<nowiki>|§")</nowiki>
t = textreplace("§|", "<nowiki>§|")</nowiki>
End Sub

Sub stripnewlines()
t = textreplace("^p^p", "<p>")
t = textreplace("^p", " ")
t = textreplace("<p>", "^p**")
End Sub

' take flat file with carriage returns at every line
' convert double carriage return to <p>, remove single returns, convert <p> to single return,
' remove extra spaces.
Sub FlatfiletoTable()
t = textreplace("^p^p", "<p>")
t = textreplace("^p", " ")
t = textreplace(" ", " ")
t = textreplace("<p>", "^p")
End Sub

Public Sub ParseLines()
Dim singleLine As Paragraph
Dim lineText As String
Set SourceDoc = ActiveDocument
Documents.Add DocumentType:=wdNewBlankDocument
Set DestinationDoc = ActiveDocument

For Each singleLine In SourceDoc.Paragraphs
lineText = singleLine.Range.Text
Selection.TypeText lineText
If Len(lineText) < 78 Then
Selection.TypeText "<p>"
End If
Next singleLine
' t = textreplace("<p>", "^p")
End Sub

Personal tools