The Logic Museum:VBA

From The Logic Museum

Jump to: navigation, 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

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:="<i>" & strTemp & "</i>"
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:="<b>" & strTemp & "</b>"
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:="<span id=" & """"
' Selection.PasteSpecial DataType:=2
' Selection.TypeText """" & "></span>"

'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:="<i>" & strTemp & "</i>"
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 & "</span>"
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:="<br>"

End Sub

Sub para()
Selection.TypeText Text:="<p></p>"
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>", "<br>")
t = textreplace("^p", "")
t = textreplace("<td>", "|")
t = textreplace("</td>", "")
t = textreplace("</tr>", "")
t = textreplace("<br>", "^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("<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(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 = "<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
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 & "]''' <span id=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 & "]''' <span id=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", "<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 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("<p>", "<nowiki><p>")</nowiki>
t = textreplace("<s>", "<nowiki><s>")</nowiki>
t = textreplace("<u>", "<nowiki><u>")</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 "<p>"
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("/>", "></span>")
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 & "]''' <span id=n" & n & " />"
' .InsertAfter "<span id=l" & n & " />"
.InsertAfter "'''[n" & n & "]''' <span id=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><span id=""n\1"" />"</nowiki>
.Replacement.Text = "[p\1] <span id=""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<p>")

' italics
t = textreplace("[i]", "<i>")
t = textreplace("[/i]", "</i>")

' bold
t = textreplace("[b]", "<b>")
t = textreplace("[/b]", "</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("<p><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> <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 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("<b>", "'''")
t = textreplace("</b>", "'''")
t = textreplace("<i>", "''")
t = textreplace("</i>", "''")
t = textreplace("<p>", "")
t = textreplace("</p>", "")

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


Personal tools