Help Converting Microsoft Word Bible to PBB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116

Sub Main()
Const BookName As String = "Matthew"
    TagChapters (BookName)
    WalkChapters (BookName)
End Sub
Sub TagChapters(Optional BookName As String = "Matthew")
'Tag All Chapters of Style Drop Cap
'and change the Style to Heading 1
'[[@Bible:BibleBook Chapter]][[Chapter>>BibleBook Chapter]]

'Add a temp char sequence at end of document
'to help find last chapter
    ActiveDocument.Content.InsertAfter ("[]")
    ActiveDocument.Range.Start = 0
    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("Drop Cap")
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles.Item("Heading 1")
With Selection.Find
        .Text = "([0-9]{1,2})"
        .Replacement.Text = "[[@Bible:" & BookName & " \1]]Chapter \1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub WalkChapters(Optional BookName As String = "Matthew")
'Select the Content of each Chapter
'and pass control to TagVerses routine
Dim Chapter As Long
Dim NextChapter As Long
Dim lEnd As Long
    Selection.HomeKey Unit:=wdStory
Do While Selection.End + 2 < ActiveDocument.Content.End
        Chapter = Chapter + 1
        Selection.Find.ClearFormatting

        Selection.Find.Replacement.ClearFormatting
With Selection.Find
            .Text = "(\])(*)(\[)"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True
End With
        Selection.Find.Execute
        lEnd = Selection.End
        TagVerses BookName, Chapter
        NextChapter = Chapter + 1
        Selection.GoTo What:=wdGoToHeading, Which:=wdGoToAbsolute, Count:=NextChapter
If Selection.Start = 0 Then Exit Do
Loop
'Remove temp [] from Document
    RemoveTag ("[]")
    Debug.Print ActiveDocument.Content.End, Selection.End
End Sub
Sub TagVerses(BookName As String, Chapter As Long)
'Tag All Verses of Style Superscipt
'[[@Bible:BibleBook Chapter:Verse]][[Verse>>BibleBook Chapter:Verse]]
    Selection.Find.ClearFormatting
With Selection.Find.Font
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Superscript = True
        .Subscript = False
End With
    Selection.Find.Replacement.ClearFormatting
With Selection.Find
        .Text = "([0-9]{1,2})"
        .Replacement.Text = "[[@Bible:" & BookName & Space(1) & Chapter & ":\1]][[\1>>" & BookName & Space(1) & Chapter & ":\1]]"
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
End With
    Selection.Find.Execute Replace:=wdReplaceAll

End Sub

Sub RemoveTag(Optional tag As String = "[]")
'Remove the temp tag that helped to find the last chapter
    Selection.HomeKey Unit:=wdStory
    ActiveDocument.Range.Start = 0
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
With Selection.Find
        .Text = "(\[\])"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub