The Logic Museum VBA

Beloved mechanical typewriter

This is one of the most viewed pages on my wiki. I have no idea why, but since it is so popular I will try and explain what it's about. Pretty much all of the functions enable me to work with both html and Mediawiki in my favoured environment, namely Microsoft word. What, you hate Microsoft word? Sure, it's not brilliant, but I know how it works, everyone uses it, and it is programmable. I have been using it a long time, and before that I used to have an old portable Remington (picture).

Some of the functions set hot keys to commonly used formatting functions like bold, italic, add anchor, add link and so on. You can set a global variable so that the same hot key does the same thing in html, in mediawiki or bulletin board format. Hot keys? Yes, I'm from the manual era where you didn't have stuff like a mouse, and you did everything using the keys. This is much quicker, in fact. I italicised mouse in about half a second using ctrl-shift-I, which is about a quarter of the time it takes to move my right hand to the mouse, move the mouse to the italic bit on the toolbar, then click, then move my hand back. No contest.

Other functions translate from one format to another. As you will have noticed, if you have looked at almost any other page in the Museum apart from this one, it makes heavy use of tables. These are pretty easy in Word, but difficult in html, and an absolute nightmare in Mediawiki. The 'table to wiki' and 'table to html' functions takes the difficulty out of this. It's also possible (though slightly messy) to convert back. Other functions make the work of digitising printed material a bit easier, for example by correcting common OCR errors (typically confusing an 'e' with a 'c' or vice versa), by removing excess carriage returns, converting non-tabular text into a table and vice versa.

To install the code, just place it in the Normal template of Word, and you are ready to go.

That's about it. With every kind wish,

Ed

Public Wiki As Integer '0 html, 1 wiki, 2 wpo</nowiki>
 
 Sub PrintCode()
 'copy this whole module into an active word document, then run this sub
 Selection.TypeText "{{VBAexplained}} "
 t = textreplace("^p", "
^p ")
 t = textreplace("{{VBAexplained}}", "{{VBAexplained}}")
 End Sub
 
 
 
 Sub SetEnvironment1() 'html
 Wiki = 0
 Options.AutoFormatAsYouTypeReplaceQuotes = True
 MsgBox "html"
 End Sub
 
 Sub SetEnvironment2() 'wiki
 Wiki = 1
 Options.AutoFormatAsYouTypeReplaceQuotes = False
 MsgBox "Wiki"
 End Sub
 
 Sub SetEnvironment3() 'wikipediocracy
 Wiki = 2
 Options.AutoFormatAsYouTypeReplaceQuotes = True
 MsgBox "Wikipediocracy"
 End Sub
 
 
 'Set the macros for adding links, italics, anchors etc to custom keys
 Sub CustomiseKeys()
 
 'KeyBindings.Key(KeyCode:=BuildKeyCode(wdKey1, wdKeyShift)).Clear 'shows how to clear back to default
 
 CustomizationContext = NormalTemplate
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyK, wdKeyControl, wdKeyShift), _
 KeyCategory:=wdKeyCategoryMacro, Command:="addlink"
 
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyI, wdKeyControl, wdKeyShift), _
 KeyCategory:=wdKeyCategoryMacro, Command:="italics"
 
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyB, wdKeyControl, wdKeyShift), _
 KeyCategory:=wdKeyCategoryMacro, Command:="embolden"
 
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKeySingleQuote, wdKeyControl), _
 KeyCategory:=wdKeyCategoryMacro, Command:="addpicture"
 
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyA, wdKeyControl, wdKeyShift), _
 KeyCategory:=wdKeyCategoryMacro, Command:="addanchor"
 
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyN, wdKeyControl, wdKeyShift), _
 KeyCategory:=wdKeyCategoryMacro, Command:="addreference"
 
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyQ, wdKeyControl, wdKeyShift), _
 KeyCategory:=wdKeyCategoryMacro, Command:="blockquote"
 
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKey1, wdKeyControl), _
 KeyCategory:=wdKeyCategoryMacro, Command:="SetEnvironment1"
 
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), _
 KeyCategory:=wdKeyCategoryMacro, Command:="SetEnvironment2"
 
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKey3, wdKeyControl), _
 KeyCategory:=wdKeyCategoryMacro, Command:="SetEnvironment3"
 
 'added 9 Jan 2014
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyU, wdKeyControl, wdKeyShift), _
 KeyCategory:=wdKeyCategoryMacro, Command:="addusername"
 
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyW, wdKeyControl, wdKeyShift), _
 KeyCategory:=wdKeyCategoryMacro, Command:="addarticlename"
 
 'added 19 Jan 2014
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyC, wdKeyControl, wdKeyShift), _
 KeyCategory:=wdKeyCategoryMacro, Command:="addcolour"
 
 'added 8 Mar 2014
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyH, wdKeyControl, wdKeyShift), _
 KeyCategory:=wdKeyCategoryMacro, Command:="addcomment"
 
 'added 29 Apr 2014
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyReturn, wdKeyControl, wdKeyShift), _
 KeyCategory:=wdKeyCategoryMacro, Command:="carriagereturn"
 
 'added 25 May 2014
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyM, wdKeyControl, wdKeyShift), _
 KeyCategory:=wdKeyCategoryMacro, Command:="autoblockquote"
 
 'added 25 May 2014
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKeySemiColon, wdKeyControl, wdKeyShift), _
 KeyCategory:=wdKeyCategoryMacro, Command:="tablebreak"
 
 'added 6 September 2014
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyV, wdKeyControl), _
 KeyCategory:=wdKeyCategoryMacro, Command:="PasteSpec"
 
 'added 11 October 2014
 KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl, wdKeyShift), _
 KeyCategory:=wdKeyCategoryMacro, Command:="addDoubleQuote"
 
 End Sub
 
 'Copy without copying format
 Sub PasteSpec()
 Selection.PasteSpecial Link:=False, DataType:=wdPasteText
 End Sub
 
 '23 Sep 2014
 Function GetClipboard()
 Dim MyData As DataObject
 Set MyData = New DataObject
 MyData.GetFromClipboard
 GetClipboard = MyData.GetText()
 End Function
 
 
 'October 1 2014 - put text into clipboard
 Function PutClipboard(ClipText As String)
 Dim MyData As DataObject
 Set MyData = New DataObject
 MyData.SetText (ClipText)
 MyData.PutInClipboard
 End Function
 
 
 '11 October 2014 - add double quote
 Sub addDoubleQuote()
 Dim strTemp As String, strAutoformat As Boolean
 'find out current setting
 strAutoformat = Options.AutoFormatAsYouTypeReplaceQuotes
 Options.AutoFormatAsYouTypeReplaceQuotes = True
 
 strTemp = Selection.Text
 Selection.TypeText Text:="""" & strTemp & """"
 
 Options.AutoFormatAsYouTypeReplaceQuotes = strAutoformat
 End Sub
 
 
 Sub italics()
 Dim strTemp As String
 
 strTemp = Selection.Text
 
 If Wiki = 0 Then 'html
 Selection.TypeText Text:="" & strTemp & ""
 ElseIf Wiki = 1 Then 'wiki
 Options.AutoFormatAsYouTypeReplaceQuotes = False
 Selection.TypeText Text:="''" & strTemp & "''"
 ElseIf Wiki = 2 Then
 Selection.TypeText Text:="[i]" & strTemp & "[/i]" 'wikipediocracy
 End If
 End Sub
 
 Sub embolden()
 Dim strTemp As String
 
 strTemp = Selection.Text
 If Wiki = 0 Then
 Selection.TypeText Text:="" & strTemp & ""
 ElseIf Wiki = 1 Then
 Options.AutoFormatAsYouTypeReplaceQuotes = False
 Selection.TypeText Text:="'''" & strTemp & "'''"
 ElseIf Wiki = 2 Then
 Selection.TypeText Text:="[b]" & strTemp & "[/b]"
 Else
 End If
 End Sub
 
 'ctrl-K
 Sub addlink()
 Dim strTemp As String, internal As Integer
 '--- 23 sep 2014 get contents of clipboard into string variable
 Dim strURL As String, URLLength As Integer
 Dim strClipboard As String
 'define root for LM url
 strURL = "http://www.logicmuseum.com/x/index.php?title="
 URLLength = Len(strURL)
 strClipboard = GetClipboard
 '---
 
 strTemp = Selection.Text
 internal = 0
 
 'for adding internal links
 If internal = 1 Then
 'REMEMBER TO CHANGE NAME OF TEXT
 Selection.TypeText "[[Authors/Aristotle/metaphysics/l7#jp" & strTemp & "|" & strTemp & "]]"
 
 ElseIf Wiki = 1 Then
 Options.AutoFormatAsYouTypeReplaceQuotes = False
 'add branch to cover internal link as well as external link
 If InStr(1, strClipboard, strURL) Then
 strClipboard = Mid(strClipboard, URLLength + 1, 1000)
 Selection.TypeText Text:="[[" & strClipboard & "|" & strTemp & "]]"
 Else
 Selection.TypeText Text:="[" & strClipboard & " " & strTemp & "]"
 
 'removed Sep 23 2014
 'Selection.Paste
 'Selection.TypeText strClipboard
 'Selection.TypeText " " & strTemp & "]"
 End If
 
 ElseIf Wiki = 0 Then
 Selection.TypeText Text:="<a href = " & """"
 Selection.Paste
 Selection.TypeText """>" & strTemp & "</a>"
 ElseIf Wiki = 2 Then
 Selection.TypeText Text:="[url="
 Selection.Paste
 Selection.TypeText "]" & strTemp & "[/url]"
 End If
 
 End Sub
 
 'ctrl-#
 Sub addpicture()
 Dim strTemp As String
 
 ' strTemp = Selection.Text
 If Wiki = 0 Then
 Selection.TypeText Text:="<img align=""right"" height=""180px"" src=""http://www.logicmuseum.com/pictures/"
 Selection.Paste
 Selection.TypeText strTemp & """ />"
 ElseIf Wiki = 1 Then
 Selection.TypeText Text:="[["
 Selection.Paste
 Selection.TypeText "|thumb|right|260px|Description]]"
 Selection.TypeText "<div style=""clear:both;""></div>"
 ElseIf Wiki = 2 Then
 Selection.TypeText Text:="[img]"
 Selection.Paste
 Selection.TypeText Text:="[/img]"
 End If
 End Sub
 
 Sub addanchor()
 Dim strTemp As String, strSelected As String, MyData As DataObject
 Set MyData = New DataObject
 strSelected = Selection.Text
 MyData.GetFromClipboard
 strTemp = MyData.GetText(1)
 
 'If nothing selected, remove spurious char 13
 If Asc(strSelected) = 13 Then
 strSelected = ""
 End If
 
 If Wiki = 1 Then
 'deleted 1 jun 2014
 ' Selection.TypeText Text:=" ' Selection.PasteSpecial DataType:=2
 ' Selection.TypeText """" & ">"
 
 'New version 1 Jun 2014
 Selection.TypeText "{{a|" & strTemp & "|" & strSelected & "}}"
 Else
 Selection.TypeText "<a name = """ & strTemp & """>" & strSelected & "</a>"
 
 ' 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>"
 Options.AutoFormatAsYouTypeReplaceQuotes = False
 Selection.TypeText Text:="<ref>"
 Selection.PasteSpecial DataType:=2
 Selection.TypeText "</ref>"
 Else
 Selection.TypeText Text:="" & strTemp & ""
 End If
 End Sub
 
 'ctrl-Q
 Sub blockquote()
 Dim strTemp As String
 
 strTemp = Selection.Text
 If Wiki = 2 Then
 Selection.TypeText Text:="[quote]" & strTemp & "[/quote]"
 Else
 Selection.TypeText Text:="<blockquote>" & strTemp & "</blockquote>"
 End If
 End Sub
 
 'ctrl-U
 Sub addusername()
 Dim strTemp As String
 
 strTemp = Selection.Text
 If Wiki = 2 Then
 Selection.TypeText Text:="[wpuser]" & strTemp & "[/wpuser]"
 ElseIf Wiki = 1 Then
 Selection.TypeText Text:="{{u|" & strTemp & "}}"
 End If
 
 End Sub
 
 'ctrl-W
 Sub addarticlename()
 Dim strTemp As String
 
 strTemp = Selection.Text
 If Wiki = 2 Then
 Selection.TypeText Text:="[wparticle]" & strTemp & "[/wparticle]"
 ElseIf Wiki = 1 Then
 Selection.TypeText Text:="{{w|" & strTemp & "}}"
 End If
 
 End Sub
 
 'added 19 Jan 2014
 'add text and background colour using a template
 'ctrl-C
 Sub addcolour()
 Dim strTemp As String
 
 strTemp = Selection.Text
 If Wiki = 1 Then
 Selection.TypeText Text:="{{Text 1}}" & strTemp & ""
 End If
 
 End Sub
 
 'added 8 Mar 2014
 'add a comment box as a hover, with title whatever is in clipboard
 'ctrl-H
 Sub addcomment()
 Dim strTemp As String
 strTemp = Selection.Text
 If Wiki = 1 Then
 Selection.TypeText Text:="{{cm|"
 Selection.Paste
 Selection.TypeText Text:="|"
 Selection.TypeText strTemp
 Selection.TypeText Text:="}}"
 End If
 End Sub
 
 
 Sub carriagereturn()
 Selection.TypeText Text:=" "
 
 End Sub
 
 Sub para()
 Selection.TypeText Text:=""
 End Sub
 
 'convert spelling to standard museum format
 Sub replaceall()
 t = newtextreplace("siue", "sive", True)
 t = newtextreplace("uel", "vel", True)
 t = newtextreplace("uero", "vero", True)
 t = newtextreplace("uult", "vult", True)
 t = newtextreplace("uox", "vox", True)
 
 t = textreplace(" uel", " vel")
 t = textreplace("uniuer", "univer")
 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
 
 
 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>", " ")
 t = textreplace("^p", "")
 t = textreplace("<td>", "|")
 t = textreplace("</td>", "")
 t = textreplace("</tr>", "")
 t = textreplace(" ", "^p")
 'Exit Sub
 
 Selection.WholeStory
 'Set Tbl = ActiveDocument.Range.ConvertToTable(Numcolumns:=2, Separator:="|")
 ' Selection.ConvertToTable Separator:=wdSeparateByDefaultListSeparator, _
 'NumColumns:=3, NumRows:=11, AutoFitBehavior:=wdAutoFitFixed
 
 ' Oct 19 2014
 Selection.ConvertToTable Separator:="|"
 
 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("", "")
 t = textreplace("", "")
 
 t = textreplace("", "")
 ' t = textreplace("", "")
 t = textreplace("", "")
 t = textreplace("", "")
 
 t = textreplace("", "")
 t = textreplace("", "")
 
 t = textreplace("", "")
 t = textreplace("<o:p> </o:p>", "")
 t = textreplace("<b^lstyle='mso-bidi-font-weight:normal'>", "")
 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(m As Integer)
 Dim Wiki As Integer, Draft As Integer, DraftOpen As String, FontClose As String, Font As String, n As Integer
 Set SourceDoc = ActiveDocument
 Wiki = 1
 Options.AutoFormatAsYouTypeReplaceQuotes = False
 Draft = 0
 
 If Draft = 1 Then
 ' DraftOpen = ""
 ' DraftOpen = ""
 Font = ""
 DraftOpen = ""
 FontClose = ""
 Else
 DraftOpen = ""
 DraftClose = ""
 End If
 
 ' Documents.Add DocumentType:=wdNewBlankDocument
 Set DestinationDoc = ActiveDocument
 ActiveDocument.Tables(m).Range.Select
 ' Selection.EndOf Unit:=wdCell
 ' Selection.MoveDown Unit:=wdRow
 Selection.Collapse WdCollapseDirection.wdCollapseEnd
 
 
 If Wiki = 1 Then
 Options.AutoFormatAsYouTypeReplaceQuotes = False
 Selection.TypeText "{| border=1 cellpadding=10" & Chr(11)
 
 If SourceDoc.Tables(m).Columns.Count = 2 Then
 Selection.TypeText "!valign = top width=45%|Latin" & Chr(11)
 Selection.TypeText "!valign = top width=55%|English" & Chr(11)
 Else
 For Each Column In SourceDoc.Tables(m).Columns
 colw = 100 / SourceDoc.Tables(m).Columns.Count
 Selection.TypeText "!valign = top width=" & colw & "%|Column " & Column.Index & Chr(11)
 Next
 
 End If
 
 n = 0
 
 For Each Row In SourceDoc.Tables(m).Rows
 Selection.TypeText "|- valign = top" & Chr(11)
 
 For Each Column In SourceDoc.Tables(m).Columns
 If Column.IsFirst Then
 Selection.TypeText "|" 'numbering
 ' Selection.TypeText "|'''[n" & n & "]''' " 'this gives the numbering
 Else
 Selection.TypeText "|"
 End If
 
 Selection.TypeText Font & Left(Row.Cells(Column.Index).Range, Len(Row.Cells(Column.Index).Range) - 1) & FontClose & Chr(11) ' & "|" & DraftOpen & Font & Left(Row.Cells(2).Range, Len(Row.Cells(2).Range) - 1) & FontClose & FontClose & Chr(11)
 
 Next
 n = n + 1
 Next
 
 Selection.TypeText "|}"
 
 ' Selection.TypeText "[[Category:Untranslated]]"
 ' 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(m).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
 '"'''[n" & n & "]''' "
 Selection.TypeText "</tbody> </table> " & Chr(11)
 End If
 
 End Sub
 'end TableToWiki
 
 Sub WikiToTable()
 t = textreplace("|- valign = top", "<tr>")
 t = textreplace("|- valign=""top""", "<tr>")
 t = textreplace("||", "^p|") 'inline pipes converted to newline pipes
 t = textreplace("^p|", "<td>") ' 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
 t = textreplace("|}", "") 'remove final separator which confuses Word
 
 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", "ber", 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 cleanspellings2()
 t = newtextreplace("cst", "est", True)
 
 End Sub
 
 
 Sub stripnewlines()
 t = textreplace("^p^p", "")
 t = textreplace("^p", " ")
 t = textreplace("", "^p**")
 End Sub
 
 ' take flat file with carriage returns at every line
 ' convert double carriage return to , remove single returns, convert to single return,
 ' remove extra spaces.
 Sub RemoveCarriageReturns()
 t = textreplace("- ^p", "^p")
 t = textreplace("^p^p", "<~p>")
 t = textreplace("^p", " ") 'add spaces to end of line
 ' t = textreplace("^p", "") 'end of line already has space
 t = textreplace(" ", " ")
 t = textreplace("<~p>", "^p^p")
 'nowiki html specific tags
 t = textreplace("", "<nowiki>")</nowiki>
 t = textreplace("<s>", "<nowiki><s>")</nowiki>
 t = textreplace("", "<nowiki>")</nowiki>
 End Sub
 
 Public Sub ParseLines() 'try to work out which lines are shorter, indicating paragraph break
 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) < 62 Then
 Selection.TypeText ""
 End If
 
 Sub CutintoNewRow()
 Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
 Selection.Cut
 Selection.InsertRowsAbove 1
 Selection.MoveLeft Unit:=wdCharacter, Count:=1
 Selection.PasteAndFormat (wdPasteDefault)
 End Sub
 
 Sub ReplaceSpan()
 t = textreplace("/>", ">")
 End Sub
 
 Sub batch()
 EditFindLoopExample 'add numbered paras
 AddAnchors 'add links to pages etc
 nowikipipe 'unwiki the pipes in the text itself
 End Sub
 
 Sub EditFindLoopExample()
 Dim n As Integer
 n = 0
 With ActiveDocument.Content.Find
 .ClearFormatting
 .Text = "|- valign = top^l|" ' adds sections (sometime ^p/^l is needed)
 ' .Text = "^p" 'adds line numbers
 ' .Text = "[n]" 'adds sections from ms
 
 Do While .Execute(Forward:=True, Format:=True) = True
 With .Parent
 ' .InsertAfter "'''[n" & n & "]''' "
 ' .InsertAfter ""
 .InsertAfter "'''[n" & n & "]''' " 'then replace [n] with line break
 
 'If the found text is last paragraph
 If .End = ActiveDocument.Content.End Then
 Exit Do
 Else
 .Move Unit:=wdParagraph, Count:=1
 End If
 End With
 
 n = n + 1
 Loop
 End With
 End Sub
 
 Sub AddAnchors()
 '
 Selection.Find.ClearFormatting
 Selection.Find.Replacement.ClearFormatting
 With Selection.Find
 ' .Text = "\[n([0-9]{1,})\]" ' this searches for [n1] etc
 .Text = "\[([0-9]{1,})\]" ' this searches for any number in square bracket
 ' .Replacement.Text = "'''[n\1]''' <nowiki>"</nowiki>
 .Replacement.Text = "[p\1] "
 .Forward = True
 .Wrap = wdFindContinue
 .Format = False
 .MatchCase = False
 .MatchWholeWord = False
 .MatchAllWordForms = False
 .MatchSoundsLike = False
 .MatchWildcards = True
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
 End Sub
 
 Sub nowikipipe()
 Dim t As Boolean
 t = textreplace("|§", "<nowiki>|§") '</nowiki>
 t = textreplace("§|", "<nowiki>§|") '</nowiki>
 End Sub
 
 Sub PasteFormat()
 Selection.PasteAndFormat (wdPasteText)
 End Sub
 
 ' ctrl-shift-o
 Sub ANIbyDate()
 
 strTemp = Selection.Text
 tDate = CDate(strTemp)
 ' strTemp = Format(Year(tDate) & Month(tDate) & Day(tDate), "yyyymmdd")
 strTemp = Format(tDate, "yyyymmdd")
 strTemp = "http://en.wikipedia.org/w/index.php?title=Wikipedia:Administrators%27_noticeboard/Incidents&offset=" & strTemp & "&limit=500&action=history"
 Selection.TypeText strTemp
 End Sub
 
 Sub BBToHtml()
 Dim t As Integer
 
 'user
 With Selection.Find
 .Text = "\[wpuser\](*)\[\/wpuser\]"
 .Replacement.Text = "<a target=_blank title=user_talk href=http://en.wikipedia.org/wiki/User:\1>\1</a>"
 .MatchWildcards = True
 .MatchCase = True
 .Wrap = wdFindContinue
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
 
 'articlew
 With Selection.Find
 .Text = "\[wparticle\](*)\[\/wparticle\]"
 .Replacement.Text = "<a target=_blank title=article_name href=http://en.wikipedia.org/wiki/\1>\1</a>"
 .MatchWildcards = True
 .MatchCase = True
 .Wrap = wdFindContinue
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
 
 
 'Replace BB urls with html
 With Selection.Find
 .Text = "\[url=(*)\](*)\[\/url\]"
 .Replacement.Text = "<a target=_blank href=\1>\2</a>"
 .MatchWildcards = True
 .MatchCase = True
 .Wrap = wdFindContinue
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
 
 'Replace BB hyperlinks with html
 With Selection.Find
 .Text = "\[hyperlink\](*),(*)\[\/hyperlink\]"
 .Replacement.Text = "<a target=_blank href=\1>\2</a>"
 .MatchWildcards = True
 .MatchCase = True
 .Wrap = wdFindContinue
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
 
 'Replace BB links with html
 With Selection.Find
 .Text = "\[link\](*)\[\/link\]"
 .Replacement.Text = "<a target=_blank href=\1>link</a>"
 .MatchWildcards = True
 .MatchCase = True
 .Wrap = wdFindContinue
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
 
 
 'images
 With Selection.Find
 .Text = "\[img\](*)\[\/img\]"
 .Replacement.Text = "<img src=\1></a>"
 .MatchWildcards = True
 .MatchCase = True
 .Wrap = wdFindContinue
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
 
 
 ' paragraphs
 t = textreplace("^p", "^p")
 
 ' italics
 t = textreplace("[i]", "")
 t = textreplace("[/i]", "")
 
 ' bold
 t = textreplace("[b]", "")
 t = textreplace("[/b]", "")
 
 'quote
 t = textreplace("[quote]", "<blockquote>")
 t = textreplace("[/quote]", "</blockquote>")
 
 'indent
 t = textreplace("[indented]", "<blockquote>")
 t = textreplace("[/indented]", "</blockquote>")
 
 'list
 t = textreplace("[list]", "<ul>")
 t = textreplace("[/list]", "</ul>")
 
 'bullets
 t = textreplace("^p[*]", "</li>^p[*]")
 t = textreplace("[*]", "<li>")
 t = textreplace("<li>", "<li>") 'don't need para for bullets
 
 'hdtab
 t = textreplace("[hdtab]", " ")
 t = textreplace("[/hdtab]", "")
 
 '
 t = textreplace("[mdash]", "—")
 t = textreplace("[/mdash]", "")
 
 'Replace the spaces in URLs with underscore
 ReplacesSpacesinURL
 
 End Sub
 
 'Look for URL and replace any space with an underscore
 Sub ReplacesSpacesinURL()
 Dim Newstr As String
 Selection.HomeKey Unit:=wdStory 'go to the beginning
 
 While True
 With Selection.Find
 .Text = "http*\>" 'this will find any linked URL
 .MatchWildcards = True
 .MatchCase = True
 End With
 Selection.Find.Execute
 'If you find a string with a space, create a new string
 If InStr(1, Selection.Text, " ") > 0 Then
 Newstr = Replace(Selection.Text, " ", "_")
 'then do a global search and replace
 t = textreplace(Selection.Text, Newstr)
 End If
 If Selection.Find.Found = False Then
 Exit Sub
 End If
 
 Wend
 End Sub
 
 Function textreplace(sourcetext, destext)
 Selection.Find.ClearFormatting
 Selection.Find.Replacement.ClearFormatting
 Selection.HomeKey Unit:=wdStory
 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)
 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 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> " & "TITLE" & " <hr>"
 
 Print #1, " "
 
 
 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> "
 Print #1, "<hr size=2 width=""100%"" align=center>"
 Print #1, "</div>"
 Print #1, ""
 Print #1, "<a href=""../index.htm"">THE LOGIC MUSEUM</a>"
 Print #1, "Copyright (html only) (C) E.D.Buckner 2010.<o:p></o:p>"
 Print #1, "<hr size=2 width=""100%"" align=center>"
 Print #1, "</body> </html>" ' trailing html tags
 
 Close #1
 
 End Sub
 
 Sub replacewild(sourcetext, destext)
 Selection.HomeKey Unit:=wdStory
 With Selection.Find
 .Text = sourcetext
 .Replacement.Text = destext
 .MatchWildcards = True
 .Execute Replace:=wdReplaceAll
 End With
 End Sub
 
 
 Sub HtmltagstoWiki()
 'change bold, italic, para tags
 t = textreplace("", "'''")
 t = textreplace("", "'''")
 t = textreplace("", "''")
 t = textreplace("", "''")
 t = textreplace("", "")
 t = textreplace("", "")
 
 replacewild "\<a name*=*""(*)""\>", "<a name=\1>"
 replacewild "\<a name=(*)\>\</a\>", "{{a|\1}}"
 
 
 'document specific replacements here
 Selection.HomeKey Unit:=wdStory
 With Selection.Find
 ' .Text = "\{\{a|(*)\}\}'''\[(*)\]'''"
 ' .Text = "\{\{a|(*)\}\}'''(*)'''"
 .Text = "'''(*)'''\{\{a|(*)\}\}"
 .Replacement.Text = "{{a|\2|\1}}"
 .MatchWildcards = True
 .Execute Replace:=wdReplaceAll
 End With
 
 'strip quotes, spaces from links
 t = textreplace("href =", "href=")
 t = textreplace("href= ", "href=")
 t = textreplace("href=""", "href=")
 
 'strip out final quote
 Selection.HomeKey Unit:=wdStory
 With Selection.Find
 .Text = "\<a(*)""\>"
 .Replacement.Text = "<a\1>"
 .MatchWildcards = True
 .Execute Replace:=wdReplaceAll
 End With
 Selection.HomeKey Unit:=wdStory
 With Selection.Find
 .Text = "\<a href=(*)\>(*)\</a\>"
 .Replacement.Text = "[\1 \2]"
 .MatchWildcards = True
 .Execute Replace:=wdReplaceAll
 End With
 End Sub
 
 
 Sub AddNotes()
 Selection.HomeKey Unit:=wdStory
 With Selection.Find
 .Text = "|}"
 .Replacement.Text = "|}^p<noinclude>^p==Notes==^p{{reflist}}^p</noinclude>^p[[Category:Untranslated]]"
 ' .Replacement.Text = "<noinclude>^p==Notes==^p{{reflist}}^p</noinclude>^p^p==Chapter"
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
 
 End Sub
 
 
 
 'Converts word footnotes into wiki footnotes. This only works when variable 'Wiki' is set to 1
 Sub ConvertFootnotes()
 'http://msdn.microsoft.com/en-us/library/office/bb257599(v=office.12).aspx
 'http://vba-programmer.com/Snippets/Code_Word/Footnotes.html
 Dim Footy As Footnote ' , MyData As DataObject
 
 ActiveDocument.Endnotes.Convert
 Wiki = 1 ' set environment to Wiki
 
 ' Set MyData = New DataObject 'for this to work you need to insert a form (Insert Userform), which you then delete (blame Microsoft)
 
 For Each Footy In ActiveDocument.Footnotes
 ' MyData.SetText Footy.Range
 ' MyData.PutInClipboard ' Content of the footnote is now in the clipboard
 ' 1 Oct 2014
 PutClipboard (Footy.Range)
 
 Footy.Reference.Select
 Selection.Delete
 addreference ' addreference takes content of clipboard and writes it, flanked by <ref> on the left, </ref> on the right
 Next Footy
 
 End Sub
 
 
 Sub ConvertHyperlinks()
 Dim i As Integer
 ' Dim MyData As DataObject, i As Integer
 ' Set MyData = New DataObject 'for this to work you need to insert a form (Insert Userform), which you then delete (blame Microsoft)
 
 For i = 1 To ActiveDocument.Hyperlinks.Count
 If ActiveDocument.Hyperlinks(1).Address <> "" Then
 ' MyData.SetText ActiveDocument.Hyperlinks(1).Address
 ' MyData.PutInClipboard
 ' PutClipboard (ActiveDocument.Hyperlinks(1).Address)
 ' 31 jan 2015
 PutClipboard (ActiveDocument.Hyperlinks(1).Address & "#" & ActiveDocument.Hyperlinks(1).SubAddress)
 ActiveDocument.Hyperlinks(1).Range.Select
 addlink
 End If
 ActiveDocument.Hyperlinks(1).Delete
 Next i
 End Sub
 
 'added 8 Mar 2014
 'Converts word comments into wiki hover boxes. This only works when variable 'Wiki' is set to 1
 Sub ConvertComments()
 Dim MyComment As Comment ' , MyData As DataObject
 
 Wiki = 1 ' set environment to Wiki
 
 ' Set MyData = New DataObject 'for this to work you need to insert a form (Insert Userform), which you then delete (blame Microsoft)
 
 For Each MyComment In ActiveDocument.Comments
 ' MyData.SetText MyComment.Range.Text
 'MyData.PutInClipboard ' Content of the comment is now in the clipboard
 PutClipboard (MyComment.Range.Text)
 MyComment.Scope.Select
 addcomment
 MyComment.Delete
 Next MyComment
 
 End Sub
 
 Sub RemoveFields()
 For Each Field In ActiveDocument.Fields
 Field.Select
 Selection.TypeText "xxxx"
 Next Field
 t = textreplace("^pxxxx^p", " ")
 
 End Sub
 
 Sub ConvertTables()
 Dim SeparateTables As Integer
 SeparateTables = 1
 For i = 1 To ActiveDocument.Tables.Count
 TableToWiki (i)
 If SeparateTables = 1 Then
 Selection.TypeText Chr(11) & "<noinclude>"
 Selection.TypeText Chr(11) & "==Notes==" & Chr(11) & "{{reflist}}"
 Selection.TypeText "</noinclude>"
 ' Selection.TypeText "[[Category:Untranslated]]" ' only needed if not translated, obviously
 End If
 Next i
 
 If SeparateTables <> 1 Then
 Selection.TypeText Chr(11) & "<noinclude>"
 Selection.TypeText Chr(11) & "==Notes==" & Chr(11) & "{{reflist}}"
 Selection.TypeText "</noinclude>"
 ' Selection.TypeText "[[Category:Untranslated]]" ' only needed if not translated, obviously
 End If
 
 
 For i = 1 To ActiveDocument.Tables.Count
 ActiveDocument.Tables(1).Delete
 Next i
 
 End Sub
 
 Sub convertall()
 'Copy the stuff in the existing document
 Selection.WholeStory
 Selection.End = Selection.End - 1
 Selection.Copy
 'Create a new document
 Documents.Add DocumentType:=wdNewBlankDocument
 Selection.Paste
 ConvertComments
 ConvertHyperlinks
 ConvertFootnotes
 ConvertTables
 Selection.WholeStory
 Selection.End = Selection.End - 1
 Selection.Copy
 ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
 End Sub
 
 Sub convertpagenumbers()
 Selection.HomeKey Unit:=wdStory
 With Selection.Find
 .Text = "/([[0-9]{1,})/"
 .Replacement.Text = "{{p|\1}}"
 .MatchWildcards = True
 .Execute Replace:=wdReplaceAll
 End With
 End Sub
 
 Sub autoblockquote()
 '
 ' Macro9 Macro
 ' Macro recorded 25/05/2014 by Edward
 '
 Selection.Delete Unit:=wdCharacter, Count:=2
 Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
 Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
 Application.Run MacroName:="Normal.ThisDocument.blockquote"
 Selection.Delete Unit:=wdCharacter, Count:=1
 End Sub
 
 Sub tablebreak()
 ' Macro recorded 26/05/2014 by Edward
 
 Selection.EndKey Unit:=wdLine, Extend:=wdExtend
 Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
 Selection.Cut
 Selection.Rows.Delete
 Selection.SplitTable
 Selection.TypeParagraph
 Selection.TypeParagraph
 Selection.MoveUp Unit:=wdLine, Count:=1
 Selection.Paste
 End Sub
 
 
 Sub tempAquinas()
 t = textreplace("<a href=""", "*[[")
 t = textreplace(""">", "|")
 t = textreplace("</a>", "]]")
 End Sub
 
 Sub tempPhysics()
 Selection.Find.Replacement.ClearFormatting
 With Selection.Find
 ' .Text = "\<a href=""../../aristotle/physics/physics.htm#bk([0-9]{1,}[a,b][0-9]{1,})""\>([0-9]{1,} [a,b] [0-9]{1,})\</a\>" 'with spaces e.g. 200 b 12
 .Text = "\<a href=""../../aristotle/physics/physics.htm#bk([0-9]{1,}[a,b][0-9]{1,})""\>([0-9]{1,})([a,b][0-9]{1,})\</a\>" 'without spaces e.g. 200b12
 'need to specify which book, e.g. liber1, liber2 etc
 ' .Replacement.Text = "[[Authors/Aristotle/physics/liber3#bk\1|\2]]"
 .Replacement.Text = "{{physics|8|bk\1|\2 \3}}"
 .Forward = True
 .Wrap = wdFindContinue
 .Format = False
 .MatchCase = False
 .MatchWholeWord = False
 .MatchAllWordForms = False
 .MatchSoundsLike = False
 .MatchWildcards = True
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
 
 Selection.Find.Replacement.ClearFormatting
 With Selection.Find
 .Text = "\<a name=(lib[0-9]{1,}l[0-9]{1,}n[0-9]{1,})\>\</a\>\<b\>(lib. [0-9]{1,} l. [0-9]{1,} n. [0-9]{1,}) \</b\>"
 .Replacement.Text = "{{a|\1|\2}} "
 .Forward = True
 .Wrap = wdFindContinue
 .Format = False
 .MatchCase = False
 .MatchWholeWord = False
 .MatchAllWordForms = False
 .MatchSoundsLike = False
 .MatchWildcards = True
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
 
 
 End Sub

The Logic Museum VBA

Navigation menu

Page actions

Page actions

Personal tools

Navigation

Search

Tools