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

Attached Files

test doc overview.docx (122.5 KB, 43 views)