Wiki called WikiDoc: http://sourceforge.net/projects/wikidoc/
The following Microsoft Word 97 macros make a single word document into a mini wiki database. Sort of "wiki for one". WHAT?! If you hook the subroutime WikiDoc up to Alt-W (or whatever), whenever you press Alt-W, all wiki names (called "page names" in the code) at the beginning of pages become bookmarks (hyperlink targets) of style "heading 2". All page names not at the beginning of pages become underlined hyperlinks.
If you hook the subroutine WikiUnPage up to Alt-U (or whatever), you can press Alt-U to remove all the page breaks. This is useful if you want to print the document.
The rule used for page names is: start with uppercase and contain at least two uppercase and one lowercase.
[To copy these macros without the ?'s, click on Edit Text, then select text from the edit text box]. -- StanSilver
What a WikiDoc looks like:
----------
TopicOne
Blah blah blah TopicTwo
----------
TopicTwo
Blah blah TopicThree
----------
TopicThree
Blah blah TopicOne and TopicTwo blah blah TopicFour
----------
Sub WikiDoc()
'================================='
' Delete bookmarks and hyperlinks '
'================================='
For i = ActiveDocument.Bookmarks.Count To 1 Step -1
ActiveDocument.Bookmarks(i).Delete
Next i
For i = ActiveDocument.Hyperlinks.Count To 1 Step -1
ActiveDocument.Hyperlinks(i).Delete
Next i
'===================================='
' Set target page names as bookmarks '
'===================================='
Dim myRange As Range
For Each myRange In ActiveDocument.Words
If WikiIsPageName(myRange) Then
If WikiIsTarget(myRange) Then
'======='
' Taget '
'======='
myName = Trim(myRange.Text)
With ActiveDocument.Bookmarks
.Add Range:=myRange, Name:=myName
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
myRange.Style = wdStyleHeading2
End If
End If
Next
'================================================='
' Set link page names with targets as hyperlinks '
' Underline link page names without targets '
'================================================='
For Each myRange In ActiveDocument.Words
If WikiIsPageName(myRange) Then
If Not WikiIsTarget(myRange) Then
'======'
' Link '
'======'
myRange.Bold = False
myRange.Underline = False
myName = Trim(myRange.Text)
If ActiveDocument.Bookmarks.Exists(myName) = True Then
ActiveDocument.Hyperlinks.Add Anchor:=myRange, Address:="", SubAddress:=myName
Else
myRange.Underline = True
myRange.Font.ColorIndex = wdRed
End If
End If
End If
Next
ActiveDocument.Save
MsgBox ("Done")
End Sub
Function WikiIsPageName(myRange As Range) As Boolean
'=============================================================='
' Page name must start with an uppercase, and contain at least '
' two uppercase and one lowercase characters '
'=============================================================='
WikiIsPageName = False
If (myRange.Characters(1) > "Z") Then Exit Function
myUpperCaseCount = 0
myLowerCaseCount = 0
For Each myCharRange In myRange.Characters
If ((myCharRange <= "Z") And (myCharRange >= "A")) Then
myUpperCaseCount = myUpperCaseCount + 1
End If
If ((myCharRange <= "z") And (myCharRange >= "a")) Then
myLowerCaseCount = myLowerCaseCount + 1
End If
Next
If ((myUpperCaseCount > 1) And (myLowerCaseCount > 0)) Then
WikiIsPageName = True
End If
End Function
Function WikiIsTarget(myRange As Range) As Boolean
'============================================'
' Assume myRange is a page name. Target must '
' appear directly after a new page character '
'============================================'
WikiIsTarget = False
myStart = myRange.Start - 1
myEnd = myRange.Start
Set myPreviousRange = ActiveDocument.Range(Start:=myStart, End:=myEnd)
myPreviousChar = myPreviousRange.Characters(1).Text
If Asc(myPreviousChar) = 12 Then WikiIsTarget = True
End Function
Sub WikiUnPage()
'==============================='
' Remove all manual page breaks '
'==============================='
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^m"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Suggestion for Speedup:
I removed the lowercase part:
If ((myCharRange <= "z") And (myCharRange >= "a")) Then
myLowerCaseCount = myLowerCaseCount + 1
End If
and replaced the WikiPageName criterion:
If ((myUpperCaseCount > 1) And (myLowerCaseCount > 0)) Then
WikiIsPageName = True
End If
By:
If (myUpperCaseCount > 1) Then
WikiIsPageName = True
End If
The MicrosoftWord interpreter thanks it with greater speed and we have more flexible WikiPageNames. See http://www.data-music.com for useful samples. -- FridemarPache
I found the above code to take greater than 15 seconds to execute even for a small document. The following code is much faster by allowing links to be created on demand, instead of processing the entire document each time. If the macro WikiCreateLink is executed (I have a key bound to this) after typing a Wiki Word, then a link is created to the bookmark with the same name as the Wiki Word. If that bookmark doesn't exist, then the WikiWord is made into a Macro Button field. When this macro button field is double clicked, a page break, along with a page title and a new bookmark is inserted at the end of the current page. I like to set the value of the Field Shading dropdown in the Tools->Options->View Tab to Always so the links to the nonexisting pages stand out. The following code also requires the WikiIsPageName macro from the above code. -- BrianTheado
Sub WikiCreateLink()
'
' Create a Wiki link out of the nearest word to the left
'
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
If WikiIsPageName(Selection.Words.First) Then
myName = Trim(Selection.Words.First)
If ActiveDocument.Bookmarks.Exists(myName) = True Then
' Page already exists - add a hyperlink
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Words.First, Address:="", SubAddress:=myName
Else
'
' Page doesn't exist turn the word into a macrobutton
' field that will create a new page when double clicked
'
Selection.Words.First.underline = True
Selection.Words.First.Font.ColorIndex = wdRed
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldMacroButton, Text:= _
"WikiAddNewPage " + myName, PreserveFormatting:=False
End If
End If
End Sub
Sub WikiAddNewPage()
' Remove the macrobutton field
Selection.Fields.Unlink
' Hyperlink the word to the about to be created page
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
myName = Selection.Words.First.Text
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Words.First, Address:="", SubAddress:=myName
If ActiveDocument.Bookmarks.Exists(myName) = False Then
' Move to just beyond the next page break and create the new page
FindPageBreak
Selection.MoveRight
WikiCreatePage (myName)
End If
End Sub
Sub WikiCreatePage(myName As String)
Selection.TypeText Text:=myName
Selection.Style = wdStyleHeading1
ActiveDocument.Bookmarks.Add Range:=Selection.Words.First, Name:=myName
Selection.TypeParagraph
Selection.InsertBreak Type:=wdPageBreak
Selection.MoveUp
End Sub
Sub FindPageBreak()
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^m"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
End Sub
on my Word97 SR2 installation, I had to add one line of code:
Sub WikiCreatePage(myName As String)
myName = RTrim(myName)
...
-- TimmDanker
This quick linking feature is very helpful. I adapted the WikiDoc routine to also insert macro button fields for unknown Wiki Words, but describing this as changes to the code above would become unreadable, so if anyone is interested, please send me an email. -- RalfHandl
''Alas, I wasn't able to get any of these macros to work on my Word97 setup. Ralf, where is your email address? -- MichaelBrown
Function WikiIsPageName(myRange As Range) As Boolean
WikiIsPageName = (myRange.Case = wdToggleCase)
End Function
... seems to do what we want (and quickly). Now one can inline the function. -- FalkBruegmann
Well, at least on my machine (WinNT, Office97) this is much slower than the original function. -- RalfHandl
Does this work with OfficeXP, too? I tried and it didn't work. Any improvement suggestions? -- PeterHenning
So, here's my preliminary version based on BrianTheado's. Name restrictions are only given by Word. Why use WikiNames if the Wiki doesn't automatically detect them? I tried to install a routine that converts illegal WikiWords into legal ones (in my sense). Unfortunately, I never used VBA with Word before... -- GüntherLehnert
' WordWiki
' Tested with <a href="http://www.serverlogic3.com/lm/rtl3.asp?si=1&k=office%20xp" onmouseover="window.status='Office XP'; return true;" onmouseout="window.status=''; return true;">Office XP</a>
Sub WikiLink()
' Hyperlink the word to the about to be created page
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
myName = Selection.Words.First.Text
' Begin Word with a letter
Do While NumberRange(Asc(Left(myName, 1))) < 2
myName = Right(myName, Len(myName) - 1)
Loop
' End with the last allowed character
Do While NumberRange(Asc(Right(myName, 1))) < 1
myName = Left(myName, Len(myName) - 1)
Loop
' Delete characters not allowed in Links
i = 1
Do While i < Len(myName)
If NumberRange(Asc(Mid(myName, i, 1))) = 0 Then
myName = Left(myName, i - 1) & Right(myName, Len(myName) - i)
Else
i = i + 1
End If
Loop
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Words.First, Address:="", SubAddress:=myName
If ActiveDocument.Bookmarks.Exists(myName) = False Then
' Move to just beyond the next page break and create the new page
FindPageBreak
Selection.MoveRight
WikiCreatePage (myName)
End If
End Sub
' Checks for allowed characters
' How could you do this easier?
Function NumberRange(Number As Byte) As Integer
NumberRange = 0
If Number > 47 And Number < 58 Then NumberRange = 1
If Number > 64 And Number < 91 Then NumberRange = 2
If Number > 96 And Number < 123 Then NumberRange = 2
If Number > 191 And Number < 215 Then NumberRange = 2
If Number > 215 And Number < 247 Then NumberRange = 2
If Number > 248 And Number < 256 Then NumberRange = 2
If Number = 95 Then NumberRange = 1
End Function
Sub WikiCreatePage(myName As String)
Selection.TypeText Text:=myName
Selection.Style = wdStyleHeading1
ActiveDocument.Bookmarks.Add Range:=Selection.Words.First, Name:=myName
Selection.TypeParagraph
Selection.InsertBreak Type:=wdPageBreak
Selection.MoveUp
End Sub
Sub FindPageBreak(Optional joke As Boolean) '<- so it is not displayed as a separate macro
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^m"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
End Sub
Please see my site at http://www.SuperThinking.com. I have a Word Addin there. Could use some de-klugeing, but addresses many of the aspirations of some of these macros.
--RichVanSchaik
This link/domain is gone/expired. -- John Godin