Thursday, June 1, 2017

Word Macro for inserting Hyperlinks for/to every page break (chapter)

This Word Macro automates the inserting of hyperlinks (Table of Contents)

It first inserts 500 spaces wherever you currently are, then replaces one for each chapter (^m) it finds, and labels it whatever the first line is.

It's a little rough but it works.

Sub HypLinkCh()
'
' HypLinkCh Macro
' Macro recorded 1/1/2002 by R
'
aStartPoint = Selection.End 'Where the cursor is now
aa = Selection.Start 'Where the TOC is to be put

CH = inputbox("Enter or I To insert 500 spaces here" & Chr(13) & _
"It Eats one chr per chapter, S to skip", , "I")
If CH = "I" Or CH = "i" Then Selection.TypeText Text:=String(500, " ")


FindNext:
Selection.MoveDown Unit:=wdLine, Count:=1


Selection.Find.ClearFormatting
With Selection.Find
.Text = "^m"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.EndKey Unit:=wdLine
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
If Selection.End = Selection.Start Then
Selection.Start = Selection.Start - 2
End If
Selection.Copy
aLastPoint = Selection.End

' If bb = "1" Then
' bb = "2"
' CH = "s"
' Else
CH = inputbox("enter or A to add, S to skip, X to end", , "A")
' End If


If CH = "A" Then
Selection.Start = aa
Selection.End = aa
Selection.PasteSpecial Link:=True, DataType:=wdPasteHyperlink
aa = Selection.End + 1
aLastPoint = aLastPoint + Len(Selection.Text)
' Selection.EndOf

Selection.Start = aLastPoint + 100
Selection.End = aLastPoint + 100
' Selection.EndOf
bb = "1"
GoTo FindNext:
End If
If CH = "S" Or CH = "s" Then GoTo FindNext:
Selection.Start = aa

1 comment: