Hi,
Thanks again for your efforts...
Here is the code as I changed last night and added the line you mentioned and the books...
I have also uploaded the document I am trying to format so that gives a better idea of "real world" variants that I have to format...
Option Explicit
'Sub VBA_scripture_formatting()
' Note the use of module scope constants and variable
Const NAME As Long = 0
Const CHAPTER As Long = 1
Const VERSE_1 As Long = 2
Const VERSE_2 As Long = 3
Const NULL_REFERENCE As String = ",,,"
Const SPACE As String = " "
Const COMMA As String = ","
Const SEMI_COLON As String = ";"
Const HYPHEN As String = "-"
Const USCORE As String = "_"
Const LBRACKET As String = "("
Const RBRACKET As String = ")"
Const COLON As String = ":"
Const POINT As String = "."
Const FULL_HYPERLINK As Boolean = True
Const VERSE_ONLY_HYPERLINK As Boolean = False
Const AUTHORITY_PLACEHOLDER As String = "<authority>"
Const PATH_TO_REFERENCES As String = "W:\SkyDrive\Docs\Theocratic\Bible 2013\Bible Books\<authority>.htm#chpt_"
Const LIST_OF_AUTHORITIES As String = "Genesis, Exodus, Leviticus, Numbers, Deuteronomy, Joshua, Judges, Ruth, 1Samuel, 2Samuel, 1Kings, 2Kings, " _
& "1Chronicles, 2Chronicles, Ezra, Nehemiah, Esther, Job, Psalms, Proverbs, Ecclesiastes, " _
& "Isaiah, Jeremiah, Lamentations, Ezekiel, Daniel, Hosea, Joel, Amos, Obadiah, Jonah, Micah, " _
& "Nahum, Habakkuk, Zephaniah, Haggai, Zechariah, Malachi, Matthew, Mark, Luke, John, Acts, " _
& "Romans, 1Corinthians, 2Corinthians, Galatians, Ephesians, Philippians, Colossians, 1Thessalonians, " _
& "2Thessalonians, 1Timothy, 2Timothy, Titus, Philemon, Hebrews, " _
& "James, 1Peter, 2Peter, 1John, 2John, 3John, Jude, Revelation, "
Private authority_ref() As String
Sub main()
Dim authorities() As String
Dim authority As Variant
authorities = Split(Replace(LIST_OF_AUTHORITIES, SPACE, vbNullString), COMMA)
authority_ref = Split(NULL_REFERENCE, COMMA)
For Each authority In authorities 'authority is a variant but the sub argument is a string hence the cast
authority_ref(NAME) = CStr(authority)
insert_authority_hyperlinks
Next
End Sub
Sub insert_authority_hyperlinks()
' The search text means the following
' Search terms have been split into a number of terms using ()
'(<authority>) find text starting with the reference authority
'(*) select all characters until the character specified in the next () field
'(
include the colon in the selection
'(*) select all characters until the character specified in the next field is found
'([ ,-;]) select all characters until we find a space, comma, hyphen or semicolon
Const PRIMARY_SEARCH_TEXT As String = "(<authority>)( @)([0-9])(*)(
(*)([ ,\-;])"
Dim rng As Word.Range
Dim end_of_rng As Long
Set rng = ActiveDocument.StoryRanges(wdMainTextStory)
Do
With rng.Find
.Text = Replace(PRIMARY_SEARCH_TEXT, AUTHORITY_PLACEHOLDER, authority_ref(NAME))
.MatchWildcards = True
.Forward = True
.Wrap = wdFindStop
.Execute
If .Found Then
process_single_hyperlink rng, FULL_HYPERLINK
End If
End With
Loop Until Not rng.Find.Found
End Sub
Function process_single_hyperlink(rng As Word.Range, hyperlink_type As Boolean)
Const AFTER_A_NUMBER As String = " ),.;"
Const RUN_OF_NUMBERS As String = "([0-9]{1,})"
Dim last_char As String
last_char = rng.Characters.Last.Text
Select Case last_char
Case HYPHEN
rng.MoveEndUntil cset:=AFTER_A_NUMBER
authority_ref(NAME) = Split(rng.Text, SPACE)(0)
authority_ref(CHAPTER) = Split(Split(rng.Text, SPACE)(1), COLON)(0)
authority_ref(VERSE_1) = Split(Split(rng.Text, COLON)(1), HYPHEN)(0)
'Just in case you need the end reference
authority_ref(VERSE_2) = Split(Split(rng.Text, COLON)(1), HYPHEN)(1)
authority_ref(VERSE_2) = Mid$(authority_ref(VERSE_2), 1, Len(authority_ref(VERSE_2)) - 1)
insert_hyperlink rng, FULL_HYPERLINK
If last_char = COMMA Then
insert_hyperlink rng, VERSE_ONLY_HYPERLINK
End If
Case COMMA
rng.MoveEnd Unit:=wdCharacter, Count:=-1
authority_ref(NAME) = Split(rng.Text, SPACE)(0)
authority_ref(CHAPTER) = Split(Split(rng.Text, SPACE)(1), COLON)(0)
authority_ref(VERSE_1) = Split(Split(rng.Text, COLON)(1), HYPHEN)(0)
insert_hyperlink rng, FULL_HYPERLINK
If rng.Characters.Last = "," Then
rng.Select
rng.End = ActiveDocument.StoryRanges(wdMainTextStory).End
rng.Select
With rng.Find
.Text = RUN_OF_NUMBERS
.MatchWildcards = True
.Forward = True
.Wrap = wdFindStop
.Execute
End With
rng.MoveEnd Unit:=wdCharacter, Count:=1
process_single_hyperlink rng, VERSE_ONLY_HYPERLINK
End If
Case SPACE, SEMI_COLON, POINT, RBRACKET
rng.MoveEndWhile cset:=AFTER_A_NUMBER, Count:=wdBackward
' rng.MoveEnd Unit:=wdCharacter, Count:=-1
If hyperlink_type = FULL_HYPERLINK Then
authority_ref(NAME) = Split(rng.Text, SPACE)(0)
authority_ref(CHAPTER) = Split(Split(rng.Text, SPACE)(1), COLON)(0)
authority_ref(VERSE_1) = Split(Split(rng.Text, COLON)(1), HYPHEN)(0)
Else
authority_ref(VERSE_1) = rng.Text
End If
insert_hyperlink rng, hyperlink_type
Case Else
MsgBox "Oops. We found something that wasn't expected. The problem text is selected", vbOKOnly
rng.Select
' Stop
End Select
End Function
Sub insert_hyperlink(reference As Word.Range, hyperlink_type As Boolean)
Dim range_len As Long
range_len = reference.Characters.Count
ActiveDocument.Hyperlinks.Add _
Anchor:=reference, _
Address:= _
Replace(PATH_TO_REFERENCES, AUTHORITY_PLACEHOLDER, authority_ref(NAME)) _
& authority_ref(CHAPTER) _
& "_" _
& authority_ref(VERSE_1), _
TextToDisplay:=IIf(hyperlink_type, reference.Text, authority_ref(VERSE_1))
reference.MoveStart Unit:=wdCharacter, Count:=range_len
End Sub