The Logic Museum VBA

From The Logic Museum
(Redirected from The Logic Museum:VBA)
Jump to navigationJump to search
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>
<br>
<br>Sub PrintCode()
<br> 'copy this whole module into an active word document, then run this sub
<br> Selection.TypeText "{{VBAexplained}}<br>"
<br> t = textreplace("^p", "
^p<br>")
<br> t = textreplace("{{VBAexplained}}", "{{VBAexplained}}")
<br> End Sub
<br>
<br>
<br>
<br> Sub SetEnvironment1() 'html
<br> Wiki = 0
<br> Options.AutoFormatAsYouTypeReplaceQuotes = True
<br> MsgBox "html"
<br> End Sub
<br>
<br> Sub SetEnvironment2() 'wiki
<br> Wiki = 1
<br> Options.AutoFormatAsYouTypeReplaceQuotes = False
<br> MsgBox "Wiki"
<br> End Sub
<br>
<br> Sub SetEnvironment3() 'wikipediocracy
<br> Wiki = 2
<br> Options.AutoFormatAsYouTypeReplaceQuotes = True
<br> MsgBox "Wikipediocracy"
<br> End Sub
<br>
<br>
<br> 'Set the macros for adding links, italics, anchors etc to custom keys
<br> Sub CustomiseKeys()
<br>
<br> 'KeyBindings.Key(KeyCode:=BuildKeyCode(wdKey1, wdKeyShift)).Clear 'shows how to clear back to default
<br>
<br> CustomizationContext = NormalTemplate
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyK, wdKeyControl, wdKeyShift), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="addlink"
<br>
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyI, wdKeyControl, wdKeyShift), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="italics"
<br>
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyB, wdKeyControl, wdKeyShift), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="embolden"
<br>
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKeySingleQuote, wdKeyControl), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="addpicture"
<br>
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyA, wdKeyControl, wdKeyShift), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="addanchor"
<br>
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyN, wdKeyControl, wdKeyShift), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="addreference"
<br>
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyQ, wdKeyControl, wdKeyShift), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="blockquote"
<br>
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKey1, wdKeyControl), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="SetEnvironment1"
<br>
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="SetEnvironment2"
<br>
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKey3, wdKeyControl), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="SetEnvironment3"
<br>
<br> 'added 9 Jan 2014
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyU, wdKeyControl, wdKeyShift), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="addusername"
<br>
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyW, wdKeyControl, wdKeyShift), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="addarticlename"
<br>
<br> 'added 19 Jan 2014
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyC, wdKeyControl, wdKeyShift), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="addcolour"
<br>
<br> 'added 8 Mar 2014
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyH, wdKeyControl, wdKeyShift), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="addcomment"
<br>
<br> 'added 29 Apr 2014
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyReturn, wdKeyControl, wdKeyShift), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="carriagereturn"
<br>
<br> 'added 25 May 2014
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyM, wdKeyControl, wdKeyShift), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="autoblockquote"
<br>
<br> 'added 25 May 2014
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKeySemiColon, wdKeyControl, wdKeyShift), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="tablebreak"
<br>
<br> 'added 6 September 2014
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyV, wdKeyControl), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="PasteSpec"
<br>
<br> 'added 11 October 2014
<br> KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl, wdKeyShift), _
<br> KeyCategory:=wdKeyCategoryMacro, Command:="addDoubleQuote"
<br>
<br> End Sub
<br>
<br> 'Copy without copying format
<br> Sub PasteSpec()
<br> Selection.PasteSpecial Link:=False, DataType:=wdPasteText
<br> End Sub
<br>
<br> '23 Sep 2014
<br> Function GetClipboard()
<br> Dim MyData As DataObject
<br> Set MyData = New DataObject
<br> MyData.GetFromClipboard
<br> GetClipboard = MyData.GetText()
<br> End Function
<br>
<br>
<br>'October 1 2014 - put text into clipboard
<br>Function PutClipboard(ClipText As String)
<br>Dim MyData As DataObject
<br>Set MyData = New DataObject
<br>MyData.SetText (ClipText)
<br>MyData.PutInClipboard
<br>End Function
<br>
<br>
<br>'11 October 2014 - add double quote
<br> Sub addDoubleQuote()
<br> Dim strTemp As String, strAutoformat As Boolean
<br> 'find out current setting
<br> strAutoformat = Options.AutoFormatAsYouTypeReplaceQuotes
<br> Options.AutoFormatAsYouTypeReplaceQuotes = True
<br>
<br> strTemp = Selection.Text
<br> Selection.TypeText Text:="""" & strTemp & """"
<br>
<br> Options.AutoFormatAsYouTypeReplaceQuotes = strAutoformat
<br> End Sub
<br>
<br>
<br> Sub italics()
<br> Dim strTemp As String
<br>
<br> strTemp = Selection.Text
<br>
<br> If Wiki = 0 Then 'html
<br> Selection.TypeText Text:="<i>" & strTemp & "</i>"
<br> ElseIf Wiki = 1 Then 'wiki
<br> Options.AutoFormatAsYouTypeReplaceQuotes = False
<br> Selection.TypeText Text:="''" & strTemp & "''"
<br> ElseIf Wiki = 2 Then
<br> Selection.TypeText Text:="[i]" & strTemp & "[/i]" 'wikipediocracy
<br> End If
<br> End Sub
<br>
<br> Sub embolden()
<br> Dim strTemp As String
<br>
<br> strTemp = Selection.Text
<br> If Wiki = 0 Then
<br> Selection.TypeText Text:="<b>" & strTemp & "</b>"
<br> ElseIf Wiki = 1 Then
<br> Options.AutoFormatAsYouTypeReplaceQuotes = False
<br> Selection.TypeText Text:="'''" & strTemp & "'''"
<br> ElseIf Wiki = 2 Then
<br> Selection.TypeText Text:="[b]" & strTemp & "[/b]"
<br> Else
<br> End If
<br> End Sub
<br>
<br> 'ctrl-K
<br> Sub addlink()
<br> Dim strTemp As String, internal As Integer
<br> '--- 23 sep 2014 get contents of clipboard into string variable
<br> Dim strURL As String, URLLength As Integer
<br> Dim strClipboard As String
<br> 'define root for LM url
<br> strURL = "http://www.logicmuseum.com/x/index.php?title="
<br> URLLength = Len(strURL)
<br> strClipboard = GetClipboard
<br> '---
<br>
<br> strTemp = Selection.Text
<br> internal = 0
<br>
<br> 'for adding internal links
<br> If internal = 1 Then
<br> 'REMEMBER TO CHANGE NAME OF TEXT
<br> Selection.TypeText "[[Authors/Aristotle/metaphysics/l7#jp" & strTemp & "|" & strTemp & "]]"
<br>
<br> ElseIf Wiki = 1 Then
<br> Options.AutoFormatAsYouTypeReplaceQuotes = False
<br> 'add branch to cover internal link as well as external link
<br> If InStr(1, strClipboard, strURL) Then
<br> strClipboard = Mid(strClipboard, URLLength + 1, 1000)
<br> Selection.TypeText Text:="[[" & strClipboard & "|" & strTemp & "]]"
<br> Else
<br> Selection.TypeText Text:="[" & strClipboard & " " & strTemp & "]"
<br>
<br> 'removed Sep 23 2014
<br> 'Selection.Paste
<br> 'Selection.TypeText strClipboard
<br> 'Selection.TypeText " " & strTemp & "]"
<br> End If
<br>
<br> ElseIf Wiki = 0 Then
<br> Selection.TypeText Text:="<a href = " & """"
<br> Selection.Paste
<br> Selection.TypeText """>" & strTemp & "</a>"
<br> ElseIf Wiki = 2 Then
<br> Selection.TypeText Text:="[url="
<br> Selection.Paste
<br> Selection.TypeText "]" & strTemp & "[/url]"
<br> End If
<br>
<br> End Sub
<br>
<br> 'ctrl-#
<br> Sub addpicture()
<br> Dim strTemp As String
<br>
<br> ' strTemp = Selection.Text
<br> If Wiki = 0 Then
<br> Selection.TypeText Text:="<img align=""right"" height=""180px"" src=""http://www.logicmuseum.com/pictures/"
<br> Selection.Paste
<br> Selection.TypeText strTemp & """ />"
<br> ElseIf Wiki = 1 Then
<br> Selection.TypeText Text:="[["
<br> Selection.Paste
<br> Selection.TypeText "|thumb|right|260px|Description]]"
<br> Selection.TypeText "<div style=""clear:both;""></div>"
<br> ElseIf Wiki = 2 Then
<br> Selection.TypeText Text:="[img]"
<br> Selection.Paste
<br> Selection.TypeText Text:="[/img]"
<br> End If
<br> End Sub
<br>
<br> Sub addanchor()
<br> Dim strTemp As String, strSelected As String, MyData As DataObject
<br> Set MyData = New DataObject
<br> strSelected = Selection.Text
<br> MyData.GetFromClipboard
<br> strTemp = MyData.GetText(1)
<br>
<br> 'If nothing selected, remove spurious char 13
<br> If Asc(strSelected) = 13 Then
<br> strSelected = ""
<br> End If
<br>
<br> If Wiki = 1 Then
<br> 'deleted 1 jun 2014
<br> ' Selection.TypeText Text:="<span id=" & """"
<br> ' Selection.PasteSpecial DataType:=2
<br> ' Selection.TypeText """" & "></span>"
<br>
<br> 'New version 1 Jun 2014
<br> Selection.TypeText "{{a|" & strTemp & "|" & strSelected & "}}"
<br> Else
<br> Selection.TypeText "<a name = """ & strTemp & """>" & strSelected & "</a>"
<br>
<br> ' Selection.TypeText Text:="<a name = " & """"
<br> ' Selection.PasteSpecial DataType:=2
<br> ' Selection.TypeText """" & "></a>"
<br> End If
<br> End Sub
<br>
<br> Sub addreference()
<br> Dim strTemp As String
<br>
<br> ' strTemp = Selection.Text
<br>
<br> If Wiki = 1 Then
<br> ' Selection.TypeText Text:="<ref>" & strTemp & "</ref>"
<br> Options.AutoFormatAsYouTypeReplaceQuotes = False
<br> Selection.TypeText Text:="<ref>"
<br> Selection.PasteSpecial DataType:=2
<br> Selection.TypeText "</ref>"
<br> Else
<br> Selection.TypeText Text:="<i>" & strTemp & "</i>"
<br> End If
<br> End Sub
<br>
<br> 'ctrl-Q
<br> Sub blockquote()
<br> Dim strTemp As String
<br>
<br> strTemp = Selection.Text
<br> If Wiki = 2 Then
<br> Selection.TypeText Text:="[quote]" & strTemp & "[/quote]"
<br> Else
<br> Selection.TypeText Text:="<blockquote>" & strTemp & "</blockquote>"
<br> End If
<br> End Sub
<br>
<br> 'ctrl-U
<br> Sub addusername()
<br> Dim strTemp As String
<br>
<br> strTemp = Selection.Text
<br> If Wiki = 2 Then
<br> Selection.TypeText Text:="[wpuser]" & strTemp & "[/wpuser]"
<br> ElseIf Wiki = 1 Then
<br> Selection.TypeText Text:="{{u|" & strTemp & "}}"
<br> End If
<br>
<br> End Sub
<br>
<br> 'ctrl-W
<br> Sub addarticlename()
<br> Dim strTemp As String
<br>
<br> strTemp = Selection.Text
<br> If Wiki = 2 Then
<br> Selection.TypeText Text:="[wparticle]" & strTemp & "[/wparticle]"
<br> ElseIf Wiki = 1 Then
<br> Selection.TypeText Text:="{{w|" & strTemp & "}}"
<br> End If
<br>
<br> End Sub
<br>
<br> 'added 19 Jan 2014
<br> 'add text and background colour using a template
<br> 'ctrl-C
<br> Sub addcolour()
<br> Dim strTemp As String
<br>
<br> strTemp = Selection.Text
<br> If Wiki = 1 Then
<br> Selection.TypeText Text:="{{Text 1}}" & strTemp & "</span>"
<br> End If
<br>
<br> End Sub
<br>
<br> 'added 8 Mar 2014
<br> 'add a comment box as a hover, with title whatever is in clipboard
<br> 'ctrl-H
<br> Sub addcomment()
<br> Dim strTemp As String
<br> strTemp = Selection.Text
<br> If Wiki = 1 Then
<br> Selection.TypeText Text:="{{cm|"
<br> Selection.Paste
<br> Selection.TypeText Text:="|"
<br> Selection.TypeText strTemp
<br> Selection.TypeText Text:="}}"
<br> End If
<br> End Sub
<br>
<br>
<br> Sub carriagereturn()
<br> Selection.TypeText Text:="<br>"
<br>
<br> End Sub
<br>
<br> Sub para()
<br> Selection.TypeText Text:="<p></p>"
<br> End Sub
<br>
<br> 'convert spelling to standard museum format
<br> Sub replaceall()
<br> t = newtextreplace("siue", "sive", True)
<br> t = newtextreplace("uel", "vel", True)
<br> t = newtextreplace("uero", "vero", True)
<br> t = newtextreplace("uult", "vult", True)
<br> t = newtextreplace("uox", "vox", True)
<br>
<br> t = textreplace(" uel", " vel")
<br> t = textreplace("uniuer", "univer")
<br> t = textreplace("iuu", "ivu")
<br> t = textreplace(" ual", " val")
<br> t = textreplace(" uar", " var")
<br> t = textreplace("auis", "avis")
<br> t = textreplace("auit", "avit")
<br> t = textreplace(" uid", " vid")
<br> t = textreplace("breui", "brevi")
<br> t = textreplace("leui", "levi")
<br> t = textreplace("oui", "ovi")
<br> t = textreplace("eui", "evi")
<br> t = textreplace("ciui", "civi")
<br> t = textreplace(" uen", " ven")
<br> t = textreplace("oue", "ove")
<br> t = textreplace("iui", "ivi")
<br> t = textreplace("ueni", "veni")
<br> t = textreplace(" uer", " ver")
<br> t = textreplace("iuo", "ivo")
<br> t = textreplace("aui", "avi")
<br> t = textreplace("serua", "serva")
<br> t = textreplace(" ui", " vi")
<br> t = textreplace("inue", "inve")
<br> t = textreplace("adue", "adve")
<br> t = textreplace("iua", "iva")
<br> t = textreplace("iue", "ive")
<br> t = textreplace("solui", "solvi")
<br> t = textreplace(" uo", " vo")
<br> t = textreplace("priua", "priva")
<br> t = textreplace("solua", "solva")
<br> t = textreplace("conue", "conve")
<br> t = textreplace("aue", "ave")
<br> t = textreplace("quamuis", "quamvis")
<br> t = textreplace("inuicem", "invicem")
<br>
<br> End Sub
<br>
<br> Sub removecorpusthomisticumID()
<br> t = textreplace("<tr> <td> [^#^#^#^#^#] ^p</td> <td> ^p</td> </tr>", "")
<br> End Sub
<br>
<br>
<br> Sub addbekker()
<br> strTemp = Selection.Text
<br> strTempTrimmed = Replace(strTemp, " ", "")
<br>
<br> If Wiki = 1 Then
<br> Else
<br> Selection.TypeText Text:="<a href=""../../aristotle/physics/physics.htm#bk" & strTempTrimmed & """>" & strTemp & "</a>"
<br> End If
<br>
<br> End Sub
<br>
<br> Sub HtmlToTable()
<br> t = textreplace("<tr>", "<br>")
<br> t = textreplace("^p", "")
<br> t = textreplace("<td>", "|")
<br> t = textreplace("</td>", "")
<br> t = textreplace("</tr>", "")
<br> t = textreplace("<br>", "^p")
<br> 'Exit Sub
<br>
<br> Selection.WholeStory
<br> 'Set Tbl = ActiveDocument.Range.ConvertToTable(Numcolumns:=2, Separator:="|")
<br>' Selection.ConvertToTable Separator:=wdSeparateByDefaultListSeparator, _
<br> 'NumColumns:=3, NumRows:=11, AutoFitBehavior:=wdAutoFitFixed
<br>
<br> ' Oct 19 2014
<br> Selection.ConvertToTable Separator:="|"
<br>
<br> With Selection.Tables(1)
<br> .Style = "Table Grid"
<br> .ApplyStyleHeadingRows = True
<br> .ApplyStyleLastRow = True
<br> .ApplyStyleFirstColumn = True
<br> .ApplyStyleLastColumn = True
<br> End With
<br> Selection.HomeKey Unit:=wdStory
<br>
<br> Selection.SelectColumn
<br> Selection.Columns.Delete
<br> End Sub
<br>
<br> Sub RossRemove()
<br> t = textreplace("^l", " ")
<br> t = textreplace("<p", "^l^l<p")
<br>
<br> t = textreplace(" ", " ")
<br> t = textreplace(" ", " ")
<br>
<br> t = textreplace("<b style='mso-bidi-font-weight:normal'>", "<b>")
<br> t = textreplace("<b style='mso-bidi-font-weight: normal'>", "<b>")
<br>
<br> t = textreplace("<span lang=EN-US>", "")
<br> ' t = textreplace("<span lang=PT-BR style='mso-ansi-language: PT-BR'>", "")
<br> t = textreplace("<span lang=PT-BR style='mso-ansi-language:PT-BR'>", "")
<br> t = textreplace("<span lang=PT-BR style='mso-ansi-language: PT-BR'>", "")
<br>
<br> t = textreplace("</span>", "")
<br> t = textreplace("<span style='mso-spacerun:yes'>", "")
<br>
<br> t = textreplace("<p class=MsoNormal>", "<p>")
<br> t = textreplace("<p><o:p> </o:p></p>", "")
<br> t = textreplace("<b^lstyle='mso-bidi-font-weight:normal'>", "<b>")
<br> t = textreplace("<o:p></o:p>", "")
<br> t = textreplace("^l^l^l", "^l^l")
<br> t = textreplace("^l^l^l", "^l^l")
<br> t = textreplace("^l^l", "^l")
<br>
<br>
<br> End Sub
<br>
<br> Sub TidyLatinScan()
<br> t = textreplace("tcr ", "ter ")
<br> t = textreplace("s i dic", "si dic")
<br> t = textreplace("cx", "ex")
<br> t = textreplace("fcct", "fect")
<br> t = textreplace("quc", "que")
<br> t = textreplace("quac", "quae")
<br> ' t = textreplace("ctc", "ect")
<br> t = textreplace("pct", "pet")
<br>
<br> t = WordReplace("pcr", "per")
<br> t = WordReplace("sc", "se")
<br> t = WordReplace("idco", "ideo")
<br>
<br> End Sub
<br>
<br> Function WordReplace(oldword As String, newword As String)
<br> With Selection.Find
<br> .Text = oldword
<br> .Replacement.Text = newword
<br> .Forward = True
<br> .Wrap = wdFindContinue
<br> .Format = False
<br> .MatchCase = False
<br> .MatchWholeWord = True
<br> End With
<br> Selection.Find.Execute Replace:=wdReplaceAll
<br> End Function
<br>
<br>
<br> Sub buildtable()
<br> 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>"
<br> End Sub
<br>
<br> Sub blogtable()
<br> 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>"
<br> End Sub
<br>
<br> Sub correctquotes()
<br> Options.AutoFormatAsYouTypeReplaceQuotes = False
<br> t = WordReplace("""", """")
<br> Options.AutoFormatAsYouTypeReplaceQuotes = True
<br> End Sub
<br>
<br> Sub toptable()
<br> t = WordReplace("|- valign = top^p", "")
<br> t = WordReplace("||[[#", "*[[#")
<br> t = WordReplace(""">", "|")
<br> t = WordReplace("||^#.^#^#", "]] ")
<br> t = WordReplace("||^#.^#", "]] ")
<br> t = WordReplace("||^#^#.^#^#", "]] ")
<br> t = WordReplace("||^#^#.^#", "]] ")
<br> t = WordReplace("||", " ")
<br>
<br> End Sub
<br>
<br> Sub TableToWiki(m As Integer)
<br> Dim Wiki As Integer, Draft As Integer, DraftOpen As String, FontClose As String, Font As String, n As Integer
<br> Set SourceDoc = ActiveDocument
<br> Wiki = 1
<br> Options.AutoFormatAsYouTypeReplaceQuotes = False
<br> Draft = 0
<br>
<br> If Draft = 1 Then
<br> ' DraftOpen = "<span style=""font-family: courier new"">"
<br> ' DraftOpen = "<span style=""background-color: #ccffcc"">"
<br> Font = "<span style=""font-family: verdana"">"
<br> DraftOpen = "<span style=""background-color: #ccffcc"">"
<br> FontClose = "</span>"
<br> Else
<br> DraftOpen = ""
<br> DraftClose = ""
<br> End If
<br>
<br> ' Documents.Add DocumentType:=wdNewBlankDocument
<br> Set DestinationDoc = ActiveDocument
<br> ActiveDocument.Tables(m).Range.Select
<br> ' Selection.EndOf Unit:=wdCell
<br> ' Selection.MoveDown Unit:=wdRow
<br> Selection.Collapse WdCollapseDirection.wdCollapseEnd
<br>
<br>
<br> If Wiki = 1 Then
<br> Options.AutoFormatAsYouTypeReplaceQuotes = False
<br> Selection.TypeText "{| border=1 cellpadding=10" & Chr(11)
<br>
<br> If SourceDoc.Tables(m).Columns.Count = 2 Then
<br> Selection.TypeText "!valign = top width=45%|Latin" & Chr(11)
<br> Selection.TypeText "!valign = top width=55%|English" & Chr(11)
<br> Else
<br> For Each Column In SourceDoc.Tables(m).Columns
<br> colw = 100 / SourceDoc.Tables(m).Columns.Count
<br> Selection.TypeText "!valign = top width=" & colw & "%|Column " & Column.Index & Chr(11)
<br> Next
<br>
<br> End If
<br>
<br> n = 0
<br>
<br> For Each Row In SourceDoc.Tables(m).Rows
<br> Selection.TypeText "|- valign = top" & Chr(11)
<br>
<br> For Each Column In SourceDoc.Tables(m).Columns
<br> If Column.IsFirst Then
<br> Selection.TypeText "|" 'numbering
<br> ' Selection.TypeText "|'''[n" & n & "]''' <span id=n" & n & " />" 'this gives the numbering
<br> Else
<br> Selection.TypeText "|"
<br> End If
<br>
<br> 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)
<br>
<br> Next
<br> n = n + 1
<br> Next
<br>
<br> Selection.TypeText "|}"
<br>
<br> ' Selection.TypeText "[[Category:Untranslated]]"
<br> ' Selection.TypeText "|" & Chr(11) & "}" ' we fixed this problem
<br>
<br>
<br> Else
<br> ' Selection.TypeText Text:="asdasd"
<br>
<br>
<br> Selection.TypeText "<table border cellpadding = 10 span = 2 >" & Chr(11)
<br>
<br> Selection.TypeText "<COL width=46% valign = top>" & Chr(11)
<br> Selection.TypeText "<COL width=54% valign = top>" & Chr(11)
<br> Selection.TypeText "<thead>" & Chr(11)
<br> Selection.TypeText "<tr> <th>Latin</th><th>English</th>" & Chr(11)
<br> Selection.TypeText "</tr> </thead> <tbody>" & Chr(11)
<br>
<br> For Each Row In SourceDoc.Tables(m).Rows
<br> 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)
<br> Next
<br> '"'''[n" & n & "]''' <span id=n" & n & " />"
<br> Selection.TypeText "</tbody> </table> " & Chr(11)
<br> End If
<br>
<br> End Sub
<br> 'end TableToWiki
<br>
<br> Sub WikiToTable()
<br> t = textreplace("|- valign = top", "<tr>")
<br> t = textreplace("|- valign=""top""", "<tr>")
<br> t = textreplace("||", "^p|") 'inline pipes converted to newline pipes
<br> t = textreplace("^p|", "<td>") ' newline pipes converted to unambiguous separator
<br> t = textreplace("^p", "")
<br> t = textreplace("<tr>", "^p")
<br> t = textreplace("^p<td>", "^p")
<br> t = textreplace("|", "<pipe>") 'all genuine pipes converted to unambiguous sign
<br> t = textreplace("<td>", "|") 'all cell pipes converted to pipe sign
<br> t = textreplace("|}", "") 'remove final separator which confuses Word
<br>
<br> Selection.WholeStory
<br> Selection.ConvertToTable Separator:=wdSeparateByDefaultListSeparator
<br> ' , NumColumns:=3, NumRows:=11, AutoFitBehavior:=wdAutoFitFixed
<br> With Selection.Tables(1)
<br> ' .Style = "Table Grid"
<br> ' .ApplyStyleHeadingRows = True
<br> ' .ApplyStyleLastRow = True
<br> ' .ApplyStyleFirstColumn = True
<br> ' .ApplyStyleLastColumn = True
<br> End With
<br> Selection.HomeKey Unit:=wdStory
<br>
<br> t = textreplace("<pipe>", "|") 'convert back to pipe sign
<br>
<br> End Sub
<br>
<br>
<br> Sub cleanspellings()
<br> t = newtextreplace("formac", "formae", True)
<br> t = newtextreplace("illc", "ille", True)
<br> t = newtextreplace("rcs", "res", False)
<br> t = newtextreplace("eriam", "etiam", True)
<br> t = newtextreplace("sinc", "sine", True)
<br> t = newtextreplace("bcat", "beat", False)
<br> t = newtextreplace("erc ", "ere ", False)
<br> t = newtextreplace("rcsp", "resp", False)
<br> t = newtextreplace("pcc", "pec", False)
<br> t = newtextreplace("nctc", "ncte", False)
<br> t = newtextreplace("expcr", "exper", False)
<br> t = newtextreplace("ctc", "etc", True)
<br> t = newtextreplace("scicn", "scien", False)
<br> t = newtextreplace("fmis", "finis", True)
<br> t = newtextreplace("supcr", "super", False)
<br> t = newtextreplace("undc", "unde", False)
<br> t = newtextreplace("dcre", "dere", False)
<br> t = newtextreplace("crcat", "creat", False)
<br> t = newtextreplace("codem", "eodem", True)
<br> t = newtextreplace("ctiam", "etiam", True)
<br> t = newtextreplace("mcdi", "medi", False)
<br> t = newtextreplace("neccss", "necess", False)
<br> t = newtextreplace("rcq", "req", False)
<br> t = newtextreplace("ncm", "nem", False)
<br> t = newtextreplace(" cv", " ev", False)
<br> t = newtextreplace("tct", "tet", False)
<br> t = newtextreplace("crgo", "ergo", False)
<br> t = newtextreplace("fortc", "forte", True)
<br> t = newtextreplace("csse", "esse", True)
<br> t = newtextreplace("essc", "esse", True)
<br> t = newtextreplace("sct", "set", False)
<br> t = newtextreplace("rcn", "ren", False)
<br> t = newtextreplace("sivc", "sive", True)
<br> t = newtextreplace("scihcet", "scilicet", False)
<br> t = newtextreplace("tcs", "tes", False)
<br> t = newtextreplace("tcl", "tel", False)
<br> t = newtextreplace(" dc", " de", False)
<br> t = newtextreplace("oht", "olit", False)
<br> t = newtextreplace("conecdo", "concedo", False)
<br> t = newtextreplace("fcr", "fer", False)
<br> t = newtextreplace("irc ", "ire ", False)
<br> t = newtextreplace("ncn", "nen", False)
<br> t = newtextreplace("crit", "erit", True)
<br> t = newtextreplace("dcb", "deb", False)
<br> t = newtextreplace("rc", "re", True)
<br> t = newtextreplace("lhg", "llig", False)
<br> t = newtextreplace("bcr", "ber", False)
<br> t = newtextreplace("qttod", "quod", False)
<br> t = newtextreplace("conecptus", "conceptus", False)
<br> t = newtextreplace("scn", "sen", False)
<br> t = newtextreplace("quaeumque", "quacumque", False)
<br> t = newtextreplace("pcrs", "pers", False)
<br> t = newtextreplace("ncs", "ncs", False)
<br> t = newtextreplace("aht", "alit", False)
<br> 'Exit Sub
<br> t = newtextreplace("$", "S", False)
<br> t = newtextreplace("lcs", "les", False)
<br> t = newtextreplace("scm", "sem", False)
<br> t = newtextreplace("ncg", "neg", False)
<br> t = newtextreplace("tahs", "tahs", True)
<br> t = newtextreplace("tuni ", "tum ", False)
<br> t = newtextreplace("tcn", "ten", False)
<br> t = newtextreplace("gcn", "gen", False)
<br> t = newtextreplace("tcm", "tem", False)
<br> t = newtextreplace("spccie", "specie", False)
<br> t = newtextreplace("scilicct", "scilicet", True)
<br> t = newtextreplace("ncc", "nec", False)
<br> t = newtextreplace("bihs", "bilis", False)
<br> t = newtextreplace("propric", "proprie", True)
<br> t = newtextreplace("ncc", "nec", True)
<br> t = newtextreplace("omnc", "omne", True)
<br> t = newtextreplace("istc", "iste", True)
<br> t = newtextreplace("itcm", "item", True)
<br> t = newtextreplace("hacc", "haec", True)
<br> t = newtextreplace("subicct", "subiect", False)
<br> t = newtextreplace("talc", "tale", True)
<br> t = newtextreplace("bct", "bet", False)
<br> t = newtextreplace("rcm", "rem", False)
<br> t = newtextreplace("practer", "praeter", True)
<br> t = newtextreplace("lcm", "lem", False)
<br> t = newtextreplace("erct", "eret", False)
<br> t = newtextreplace("patct", "patet", True)
<br> t = newtextreplace("sciJicet", "scilicet", True)
<br> t = newtextreplace("cff", "eff", False)
<br> t = newtextreplace("ciusdem", "eiusdem", True)
<br> t = newtextreplace("dcm", "dem", False)
<br> t = newtextreplace("prc", "pre", False)
<br> t = newtextreplace("dci", "dei", False)
<br> t = newtextreplace("pracdic", "praedic", False)
<br> t = newtextreplace("scqu", "sequ", False)
<br> t = newtextreplace("specic", "specie", True)
<br> t = newtextreplace("ciusdem", "eiusdem", True)
<br> t = textreplace("vidct", "videt")
<br> t = textreplace("autcm", "autem")
<br> t = textreplace("vcl", "vel")
<br> t = textreplace("rcal", "real")
<br> t = newtextreplace("rcm", "real", True)
<br> t = newtextreplace("illnd", "illud", True)
<br> End Sub
<br>
<br> Sub cleanspellings2()
<br> t = newtextreplace("cst", "est", True)
<br>
<br> End Sub
<br>
<br>
<br> Sub stripnewlines()
<br> t = textreplace("^p^p", "<p>")
<br> t = textreplace("^p", " ")
<br> t = textreplace("<p>", "^p**")
<br> End Sub
<br>
<br> ' take flat file with carriage returns at every line
<br> ' convert double carriage return to <p>, remove single returns, convert <p> to single return,
<br> ' remove extra spaces.
<br> Sub RemoveCarriageReturns()
<br> t = textreplace("- ^p", "^p")
<br> t = textreplace("^p^p", "<~p>")
<br> t = textreplace("^p", " ") 'add spaces to end of line
<br> ' t = textreplace("^p", "") 'end of line already has space
<br> t = textreplace(" ", " ")
<br> t = textreplace("<~p>", "^p^p")
<br> 'nowiki html specific tags
<br> t = textreplace("<p>", "<nowiki><p>")</nowiki>
<br> t = textreplace("<s>", "<nowiki><s>")</nowiki>
<br> t = textreplace("<u>", "<nowiki><u>")</nowiki>
<br> End Sub
<br>
<br> Public Sub ParseLines() 'try to work out which lines are shorter, indicating paragraph break
<br> Dim singleLine As Paragraph
<br> Dim lineText As String
<br> Set SourceDoc = ActiveDocument
<br> Documents.Add DocumentType:=wdNewBlankDocument
<br> Set DestinationDoc = ActiveDocument
<br> For Each singleLine In SourceDoc.Paragraphs
<br> lineText = singleLine.Range.Text
<br> Selection.TypeText lineText
<br> If Len(lineText) < 62 Then
<br> Selection.TypeText "<p>"
<br> End If
<br>
<br> Sub CutintoNewRow()
<br> Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
<br> Selection.Cut
<br> Selection.InsertRowsAbove 1
<br> Selection.MoveLeft Unit:=wdCharacter, Count:=1
<br> Selection.PasteAndFormat (wdPasteDefault)
<br> End Sub
<br>
<br> Sub ReplaceSpan()
<br> t = textreplace("/>", "></span>")
<br> End Sub
<br>
<br> Sub batch()
<br> EditFindLoopExample 'add numbered paras
<br> AddAnchors 'add links to pages etc
<br> nowikipipe 'unwiki the pipes in the text itself
<br> End Sub
<br>
<br> Sub EditFindLoopExample()
<br> Dim n As Integer
<br> n = 0
<br> With ActiveDocument.Content.Find
<br> .ClearFormatting
<br> .Text = "|- valign = top^l|" ' adds sections (sometime ^p/^l is needed)
<br> ' .Text = "^p" 'adds line numbers
<br> ' .Text = "[n]" 'adds sections from ms
<br>
<br> Do While .Execute(Forward:=True, Format:=True) = True
<br> With .Parent
<br> ' .InsertAfter "'''[n" & n & "]''' <span id=n" & n & " />"
<br> ' .InsertAfter "<span id=l" & n & " />"
<br> .InsertAfter "'''[n" & n & "]''' <span id=n" & n & " />" 'then replace [n] with line break
<br>
<br> 'If the found text is last paragraph
<br> If .End = ActiveDocument.Content.End Then
<br> Exit Do
<br> Else
<br> .Move Unit:=wdParagraph, Count:=1
<br> End If
<br> End With
<br>
<br> n = n + 1
<br> Loop
<br> End With
<br> End Sub
<br>
<br> Sub AddAnchors()
<br> '
<br> Selection.Find.ClearFormatting
<br> Selection.Find.Replacement.ClearFormatting
<br> With Selection.Find
<br> ' .Text = "\[n([0-9]{1,})\]" ' this searches for [n1] etc
<br> .Text = "\[([0-9]{1,})\]" ' this searches for any number in square bracket
<br> ' .Replacement.Text = "'''[n\1]''' <nowiki><span id=""n\1"" />"</nowiki>
<br> .Replacement.Text = "[p\1] <span id=""p\1"" />"
<br> .Forward = True
<br> .Wrap = wdFindContinue
<br> .Format = False
<br> .MatchCase = False
<br> .MatchWholeWord = False
<br> .MatchAllWordForms = False
<br> .MatchSoundsLike = False
<br> .MatchWildcards = True
<br> End With
<br> Selection.Find.Execute Replace:=wdReplaceAll
<br> End Sub
<br>
<br>Sub nowikipipe()
<br>Dim t As Boolean
<br> t = textreplace("|§", "<nowiki>|§") '</nowiki>
<br> t = textreplace("§|", "<nowiki>§|") '</nowiki>
<br>End Sub
<br>
<br> Sub PasteFormat()
<br> Selection.PasteAndFormat (wdPasteText)
<br> End Sub
<br>
<br> ' ctrl-shift-o
<br> Sub ANIbyDate()
<br>
<br> strTemp = Selection.Text
<br> tDate = CDate(strTemp)
<br> ' strTemp = Format(Year(tDate) & Month(tDate) & Day(tDate), "yyyymmdd")
<br> strTemp = Format(tDate, "yyyymmdd")
<br> strTemp = "http://en.wikipedia.org/w/index.php?title=Wikipedia:Administrators%27_noticeboard/Incidents&offset=" & strTemp & "&limit=500&action=history"
<br> Selection.TypeText strTemp
<br> End Sub
<br>
<br> Sub BBToHtml()
<br> Dim t As Integer
<br>
<br> 'user
<br> With Selection.Find
<br> .Text = "\[wpuser\](*)\[\/wpuser\]"
<br> .Replacement.Text = "<a target=_blank title=user_talk href=http://en.wikipedia.org/wiki/User:\1>\1</a>"
<br> .MatchWildcards = True
<br> .MatchCase = True
<br> .Wrap = wdFindContinue
<br> End With
<br> Selection.Find.Execute Replace:=wdReplaceAll
<br>
<br> 'articlew
<br> With Selection.Find
<br> .Text = "\[wparticle\](*)\[\/wparticle\]"
<br> .Replacement.Text = "<a target=_blank title=article_name href=http://en.wikipedia.org/wiki/\1>\1</a>"
<br> .MatchWildcards = True
<br> .MatchCase = True
<br> .Wrap = wdFindContinue
<br> End With
<br> Selection.Find.Execute Replace:=wdReplaceAll
<br>
<br>
<br> 'Replace BB urls with html
<br> With Selection.Find
<br> .Text = "\[url=(*)\](*)\[\/url\]"
<br> .Replacement.Text = "<a target=_blank href=\1>\2</a>"
<br> .MatchWildcards = True
<br> .MatchCase = True
<br> .Wrap = wdFindContinue
<br> End With
<br> Selection.Find.Execute Replace:=wdReplaceAll
<br>
<br> 'Replace BB hyperlinks with html
<br> With Selection.Find
<br> .Text = "\[hyperlink\](*),(*)\[\/hyperlink\]"
<br> .Replacement.Text = "<a target=_blank href=\1>\2</a>"
<br> .MatchWildcards = True
<br> .MatchCase = True
<br> .Wrap = wdFindContinue
<br> End With
<br> Selection.Find.Execute Replace:=wdReplaceAll
<br>
<br> 'Replace BB links with html
<br> With Selection.Find
<br> .Text = "\[link\](*)\[\/link\]"
<br> .Replacement.Text = "<a target=_blank href=\1>link</a>"
<br> .MatchWildcards = True
<br> .MatchCase = True
<br> .Wrap = wdFindContinue
<br> End With
<br> Selection.Find.Execute Replace:=wdReplaceAll
<br>
<br>
<br> 'images
<br> With Selection.Find
<br> .Text = "\[img\](*)\[\/img\]"
<br> .Replacement.Text = "<img src=\1></a>"
<br> .MatchWildcards = True
<br> .MatchCase = True
<br> .Wrap = wdFindContinue
<br> End With
<br> Selection.Find.Execute Replace:=wdReplaceAll
<br>
<br>
<br> ' paragraphs
<br> t = textreplace("^p", "^p<p>")
<br>
<br> ' italics
<br> t = textreplace("[i]", "<i>")
<br> t = textreplace("[/i]", "</i>")
<br>
<br> ' bold
<br> t = textreplace("[b]", "<b>")
<br> t = textreplace("[/b]", "</b>")
<br>
<br> 'quote
<br> t = textreplace("[quote]", "<blockquote>")
<br> t = textreplace("[/quote]", "</blockquote>")
<br>
<br> 'indent
<br> t = textreplace("[indented]", "<blockquote>")
<br> t = textreplace("[/indented]", "</blockquote>")
<br>
<br> 'list
<br> t = textreplace("[list]", "<ul>")
<br> t = textreplace("[/list]", "</ul>")
<br>
<br> 'bullets
<br> t = textreplace("^p[*]", "</li>^p[*]")
<br> t = textreplace("[*]", "<li>")
<br> t = textreplace("<p><li>", "<li>") 'don't need para for bullets
<br>
<br> 'hdtab
<br> t = textreplace("[hdtab]", " ")
<br> t = textreplace("[/hdtab]", "")
<br>
<br> '
<br> t = textreplace("[mdash]", "—")
<br>t = textreplace("[/mdash]", "")
<br>
<br> 'Replace the spaces in URLs with underscore
<br> ReplacesSpacesinURL
<br>
<br> End Sub
<br>
<br> 'Look for URL and replace any space with an underscore
<br> Sub ReplacesSpacesinURL()
<br> Dim Newstr As String
<br> Selection.HomeKey Unit:=wdStory 'go to the beginning
<br>
<br> While True
<br> With Selection.Find
<br> .Text = "http*\>" 'this will find any linked URL
<br> .MatchWildcards = True
<br> .MatchCase = True
<br> End With
<br> Selection.Find.Execute
<br> 'If you find a string with a space, create a new string
<br> If InStr(1, Selection.Text, " ") > 0 Then
<br> Newstr = Replace(Selection.Text, " ", "_")
<br> 'then do a global search and replace
<br> t = textreplace(Selection.Text, Newstr)
<br> End If
<br> If Selection.Find.Found = False Then
<br> Exit Sub
<br> End If
<br>
<br> Wend
<br> End Sub
<br>
<br> Function textreplace(sourcetext, destext)
<br> Selection.Find.ClearFormatting
<br> Selection.Find.Replacement.ClearFormatting
<br> Selection.HomeKey Unit:=wdStory
<br> With Selection.Find
<br> .Text = sourcetext
<br> .Replacement.Text = destext
<br> .Forward = True
<br> .Wrap = wdFindContinue
<br> .Format = False
<br> .MatchCase = False
<br> .MatchWholeWord = False
<br> .MatchWildcards = False
<br> .MatchSoundsLike = False
<br> .MatchAllWordForms = False
<br> End With
<br> Selection.Find.Execute Replace:=wdReplaceAll
<br> End Function
<br>
<br> Function newtextreplace(sourcetext, destext, wholeword As Boolean)
<br> Selection.Find.ClearFormatting
<br> Selection.Find.Replacement.ClearFormatting
<br> With Selection.Find
<br> .Text = sourcetext
<br> .Replacement.Text = destext
<br> .Forward = True
<br> .Wrap = wdFindContinue
<br> .Format = False
<br> .MatchCase = False
<br> .MatchWholeWord = wholeword
<br> .MatchWildcards = False
<br> .MatchSoundsLike = False
<br> .MatchAllWordForms = False
<br> End With
<br> Selection.Find.Execute Replace:=wdReplaceAll
<br> End Function
<br>
<br>
<br> Sub wikitable()
<br> Dim tablerows As Integer
<br> FilePath = "C:\Users\edward\Website\"
<br> OutputFile = FilePath & "temp.txt"
<br> Open OutputFile For Output As #1
<br>
<br>
<br> Print #1, "{| border=1 cellpadding=10"""
<br> Print #1, "!valign = top width=45%|Latin"
<br> Print #1, "!valign = top width=55%|English"
<br>
<br> For Each Row In ActiveDocument.Tables(1).Rows
<br> Print #1, "|- valign = top"
<br> Print #1, "||", Row.Cells(1).Range, "||", Row.Cells(2).Range
<br>
<br> Next
<br> Print #1, "|}"
<br> Close #1
<br>
<br> End Sub
<br>
<br>
<br> Sub TableToHtml()
<br> Dim tablerows As Integer
<br>
<br> ' tablerows = ActiveDocument.Tables(1).Rows.Count
<br>
<br> FilePath = "C:\Users\edward\Website\"
<br>
<br>
<br> OutputFile = FilePath & "temp.htm"
<br> Open OutputFile For Output As #1
<br>
<br>
<br>
<br> ' properties
<br> Print #1, "<HTML> <HEAD> <title>TITLE HERE</title>"
<br>
<br>
<br> Print #1, "<meta name=""Author"" content=""" & "AUTHOR" & """>"
<br> Print #1, "<meta name=""keywords"" content=""" & "KEYWORDS" & """ > "
<br>
<br>
<br> Print #1, "<meta http-equiv=Content-Type content=""text/html; charset=windows-1252"">" ' add other meta data stuff
<br> Print #1, "<link href=""../../logicmuseum.css"" rel=""stylesheet"" type=""text/css"">"
<br>
<br> Print #1, "</head>"
<br> Print #1, "<body>"
<br> Print #1, " <hr> <b><font size = ""+2"">" & "TITLE" & "</font></b> <hr>"
<br>
<br> Print #1, "<br><br><br>"
<br>
<br>
<br> Print #1, "<table border cellpadding = 10 span = 2 >"
<br> Print #1, "<COL width=46% valign = top>"
<br> Print #1, "<COL width=54% valign = top>"
<br> Print #1, "<thead>"
<br> Print #1, "<tr> <th>Latin</th><th>English</th>"
<br> Print #1, "</tr> </thead> <tbody>"
<br>
<br> For Each Row In ActiveDocument.Tables(1).Rows
<br> Print #1, "<tr> <td>", Row.Cells(1).Range, "</td> <td>", Row.Cells(2).Range, "</td> </tr>"
<br>
<br> Next
<br>
<br> Print #1, "</tbody> </table> <br> <br> <br> <br> <br> <br> <br>"
<br> Print #1, "<hr size=2 width=""100%"" align=center>"
<br> Print #1, "</span></div>"
<br> Print #1, "<p class=MsoNormal><span lang=EN-US style='font-family:Garamond'>"
<br> Print #1, "<a href=""../index.htm"">THE LOGIC MUSEUM</a></span><span lang=EN-US style='mso-ansi-language: EN-GB '>"
<br> 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>"
<br> Print #1, "<hr size=2 width=""100%"" align=center>"
<br> Print #1, "</body> </html>" ' trailing html tags
<br>
<br> Close #1
<br>
<br> End Sub
<br>
<br> Sub replacewild(sourcetext, destext)
<br> Selection.HomeKey Unit:=wdStory
<br> With Selection.Find
<br> .Text = sourcetext
<br> .Replacement.Text = destext
<br> .MatchWildcards = True
<br> .Execute Replace:=wdReplaceAll
<br> End With
<br> End Sub
<br>
<br>
<br> Sub HtmltagstoWiki()
<br> 'change bold, italic, para tags
<br> t = textreplace("<b>", "'''")
<br> t = textreplace("</b>", "'''")
<br> t = textreplace("<i>", "''")
<br> t = textreplace("</i>", "''")
<br> t = textreplace("<p>", "")
<br> t = textreplace("</p>", "")
<br>
<br> replacewild "\<a name*=*""(*)""\>", "<a name=\1>"
<br> replacewild "\<a name=(*)\>\</a\>", "{{a|\1}}"
<br>
<br>
<br> 'document specific replacements here
<br> Selection.HomeKey Unit:=wdStory
<br> With Selection.Find
<br> ' .Text = "\{\{a|(*)\}\}'''\[(*)\]'''"
<br> ' .Text = "\{\{a|(*)\}\}'''(*)'''"
<br> .Text = "'''(*)'''\{\{a|(*)\}\}"
<br> .Replacement.Text = "{{a|\2|\1}}"
<br> .MatchWildcards = True
<br> .Execute Replace:=wdReplaceAll
<br> End With
<br>
<br> 'strip quotes, spaces from links
<br> t = textreplace("href =", "href=")
<br> t = textreplace("href= ", "href=")
<br> t = textreplace("href=""", "href=")
<br>
<br> 'strip out final quote
<br> Selection.HomeKey Unit:=wdStory
<br> With Selection.Find
<br> .Text = "\<a(*)""\>"
<br> .Replacement.Text = "<a\1>"
<br> .MatchWildcards = True
<br> .Execute Replace:=wdReplaceAll
<br> End With
<br> Selection.HomeKey Unit:=wdStory
<br> With Selection.Find
<br> .Text = "\<a href=(*)\>(*)\</a\>"
<br> .Replacement.Text = "[\1 \2]"
<br> .MatchWildcards = True
<br> .Execute Replace:=wdReplaceAll
<br> End With
<br> End Sub
<br>
<br>
<br> Sub AddNotes()
<br> Selection.HomeKey Unit:=wdStory
<br> With Selection.Find
<br> .Text = "|}"
<br> .Replacement.Text = "|}^p<noinclude>^p==Notes==^p{{reflist}}^p</noinclude>^p[[Category:Untranslated]]"
<br> ' .Replacement.Text = "<noinclude>^p==Notes==^p{{reflist}}^p</noinclude>^p^p==Chapter"
<br> End With
<br> Selection.Find.Execute Replace:=wdReplaceAll
<br>
<br> End Sub
<br>
<br>
<br>
<br> 'Converts word footnotes into wiki footnotes. This only works when variable 'Wiki' is set to 1
<br> Sub ConvertFootnotes()
<br> 'http://msdn.microsoft.com/en-us/library/office/bb257599(v=office.12).aspx
<br> 'http://vba-programmer.com/Snippets/Code_Word/Footnotes.html
<br> Dim Footy As Footnote ' , MyData As DataObject
<br>
<br> ActiveDocument.Endnotes.Convert
<br> Wiki = 1 ' set environment to Wiki
<br>
<br>' Set MyData = New DataObject 'for this to work you need to insert a form (Insert Userform), which you then delete (blame Microsoft)
<br>
<br> For Each Footy In ActiveDocument.Footnotes
<br>' MyData.SetText Footy.Range
<br>' MyData.PutInClipboard ' Content of the footnote is now in the clipboard
<br> ' 1 Oct 2014
<br> PutClipboard (Footy.Range)
<br>
<br> Footy.Reference.Select
<br> Selection.Delete
<br> addreference ' addreference takes content of clipboard and writes it, flanked by <ref> on the left, </ref> on the right
<br> Next Footy
<br>
<br> End Sub
<br>
<br>
<br> Sub ConvertHyperlinks()
<br> Dim i As Integer
<br>' Dim MyData As DataObject, i As Integer
<br>' Set MyData = New DataObject 'for this to work you need to insert a form (Insert Userform), which you then delete (blame Microsoft)
<br>
<br> For i = 1 To ActiveDocument.Hyperlinks.Count
<br> If ActiveDocument.Hyperlinks(1).Address <> "" Then
<br>' MyData.SetText ActiveDocument.Hyperlinks(1).Address
<br>' MyData.PutInClipboard
<br>' PutClipboard (ActiveDocument.Hyperlinks(1).Address)
<br> ' 31 jan 2015
<br> PutClipboard (ActiveDocument.Hyperlinks(1).Address & "#" & ActiveDocument.Hyperlinks(1).SubAddress)
<br> ActiveDocument.Hyperlinks(1).Range.Select
<br> addlink
<br> End If
<br> ActiveDocument.Hyperlinks(1).Delete
<br> Next i
<br> End Sub
<br>
<br> 'added 8 Mar 2014
<br> 'Converts word comments into wiki hover boxes. This only works when variable 'Wiki' is set to 1
<br> Sub ConvertComments()
<br> Dim MyComment As Comment ' , MyData As DataObject
<br>
<br> Wiki = 1 ' set environment to Wiki
<br>
<br>' Set MyData = New DataObject 'for this to work you need to insert a form (Insert Userform), which you then delete (blame Microsoft)
<br>
<br> For Each MyComment In ActiveDocument.Comments
<br>' MyData.SetText MyComment.Range.Text
<br> 'MyData.PutInClipboard ' Content of the comment is now in the clipboard
<br> PutClipboard (MyComment.Range.Text)
<br> MyComment.Scope.Select
<br> addcomment
<br> MyComment.Delete
<br> Next MyComment
<br>
<br> End Sub
<br>
<br> Sub RemoveFields()
<br> For Each Field In ActiveDocument.Fields
<br> Field.Select
<br> Selection.TypeText "xxxx"
<br> Next Field
<br> t = textreplace("^pxxxx^p", " ")
<br>
<br> End Sub
<br>
<br> Sub ConvertTables()
<br>Dim SeparateTables As Integer
<br>SeparateTables = 1
<br> For i = 1 To ActiveDocument.Tables.Count
<br> TableToWiki (i)
<br> If SeparateTables = 1 Then
<br> Selection.TypeText Chr(11) & "<noinclude>"
<br> Selection.TypeText Chr(11) & "==Notes==" & Chr(11) & "{{reflist}}"
<br> Selection.TypeText "</noinclude>"
<br>' Selection.TypeText "[[Category:Untranslated]]" ' only needed if not translated, obviously
<br> End If
<br> Next i
<br>
<br>If SeparateTables <> 1 Then
<br> Selection.TypeText Chr(11) & "<noinclude>"
<br> Selection.TypeText Chr(11) & "==Notes==" & Chr(11) & "{{reflist}}"
<br> Selection.TypeText "</noinclude>"
<br>' Selection.TypeText "[[Category:Untranslated]]" ' only needed if not translated, obviously
<br>End If
<br>
<br>
<br> For i = 1 To ActiveDocument.Tables.Count
<br> ActiveDocument.Tables(1).Delete
<br> Next i
<br>
<br> End Sub
<br>
<br> Sub convertall()
<br> 'Copy the stuff in the existing document
<br> Selection.WholeStory
<br> Selection.End = Selection.End - 1
<br> Selection.Copy
<br> 'Create a new document
<br> Documents.Add DocumentType:=wdNewBlankDocument
<br> Selection.Paste
<br> ConvertComments
<br> ConvertHyperlinks
<br> ConvertFootnotes
<br> ConvertTables
<br> Selection.WholeStory
<br> Selection.End = Selection.End - 1
<br> Selection.Copy
<br> ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
<br> End Sub
<br>
<br> Sub convertpagenumbers()
<br> Selection.HomeKey Unit:=wdStory
<br> With Selection.Find
<br> .Text = "/([[0-9]{1,})/"
<br> .Replacement.Text = "{{p|\1}}"
<br> .MatchWildcards = True
<br> .Execute Replace:=wdReplaceAll
<br> End With
<br> End Sub
<br>
<br> Sub autoblockquote()
<br> '
<br> ' Macro9 Macro
<br> ' Macro recorded 25/05/2014 by Edward
<br> '
<br> Selection.Delete Unit:=wdCharacter, Count:=2
<br> Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
<br> Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
<br> Application.Run MacroName:="Normal.ThisDocument.blockquote"
<br> Selection.Delete Unit:=wdCharacter, Count:=1
<br> End Sub
<br>
<br> Sub tablebreak()
<br> ' Macro recorded 26/05/2014 by Edward
<br>
<br> Selection.EndKey Unit:=wdLine, Extend:=wdExtend
<br> Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
<br> Selection.Cut
<br> Selection.Rows.Delete
<br> Selection.SplitTable
<br> Selection.TypeParagraph
<br> Selection.TypeParagraph
<br> Selection.MoveUp Unit:=wdLine, Count:=1
<br> Selection.Paste
<br> End Sub
<br>
<br>
<br>Sub tempAquinas()
<br> t = textreplace("<a href=""", "*[[")
<br> t = textreplace(""">", "|")
<br> t = textreplace("</a>", "]]")
<br> End Sub
<br>
<br>Sub tempPhysics()
<br>Selection.Find.Replacement.ClearFormatting
<br> With Selection.Find
<br>' .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
<br> .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
<br>'need to specify which book, e.g. liber1, liber2 etc
<br>' .Replacement.Text = "[[Authors/Aristotle/physics/liber3#bk\1|\2]]"
<br> .Replacement.Text = "{{physics|8|bk\1|\2 \3}}"
<br> .Forward = True
<br> .Wrap = wdFindContinue
<br> .Format = False
<br> .MatchCase = False
<br> .MatchWholeWord = False
<br> .MatchAllWordForms = False
<br> .MatchSoundsLike = False
<br> .MatchWildcards = True
<br> End With
<br> Selection.Find.Execute Replace:=wdReplaceAll
<br>
<br>Selection.Find.Replacement.ClearFormatting
<br> With Selection.Find
<br> .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\>"
<br> .Replacement.Text = "{{a|\1|\2}} "
<br> .Forward = True
<br> .Wrap = wdFindContinue
<br> .Format = False
<br> .MatchCase = False
<br> .MatchWholeWord = False
<br> .MatchAllWordForms = False
<br> .MatchSoundsLike = False
<br> .MatchWildcards = True
<br> End With
<br> Selection.Find.Execute Replace:=wdReplaceAll
<br>
<br>
<br>End Sub