In my previous post on sorting a scripture index, I used a rather lousy way of telling where the index was in the document. This came back to bite me today when I changed the number of references to a scripture index in a manuscript. In order to avoid this, use the following code instead. This is the complete macro file with the change made.
REM ***** BASIC ***** REM ***** Sort Scripture Inde ***** REM ***** Henry Neufeld, https://hneufeld.com ***** REM ***** Feel free to use whatever of this code you find useful ***** 'stuff is the workhorse array for this. 500 entries is arbitrary. In the future I plan 'to have the routine redim if the array is too small. For now 500 entries is quite adequate Global stuff(500,6) as Variant '0 = paragraph text; 1=Object; 2=Page; 3=Passage Const S_OBJ = 0 ' The TextElement Object Const S_TEXT = 1 ' The actual text of the object; I swap the text between objects to sort Const S_PAGE = 2 ' The page number from the line, used for the final sort Const S_PASSAGE = 3 'used to detect identical entries so I can format duplicates Const S_BOOK = 4 'S_BOOK, S_CHAPTER, and S_VERSE are used solely for sorting Const S_CHAPTER = 5 Const S_VERSE = 6 Dim Bible() as String Sub Main End Sub 'Create the array of Bible books. Modify this array to use different sort orders, add the apocrypha, and so forth 'This could be more efficient than a sequential search, but since I only use the routine a few times in the lifetime 'of any manuscript the difference in speed will be unimportant Sub InitializeBible Bible = Array("Genesis", "Exodus", "Leviticus", "Numbers", "Deuteronomy", "Joshua", "Judges", "Ruth", "1 Samuel", "2 Samuel", "1 Kings", "2 Kings", _ "1 Chronicles", "2 Chronicles", "Ezra", "Nehemiah", "Esther", "Job", "Psalm", "Proverbs", "Ecclesiastes", "Song of Solomon", _ "Isaiah", "Jeremiah", "Lamentations", "Ezekiel", "Daniel", "Hosea", "Joel", "Amos", "Obadiah", "Jonah", "Micah", "Nahum", "Habakkuk", _ "Zephaniah", "Haggai", "Zechariah", "Malachi", "Matthew", "Mark", "Luke", "John", "Acts", "Romans", "1 Corinthians", "2 Corinthians", _ "Galatians", "Ephesians", "Philippians", "Colossians", "1 Thessalonians", "2 Thessalonians", "1 Timothy", "2 Timothy", "Titus", _ "Philemon", "Hebrews", "James", "1 Peter", "2 Peter", "1 John", "2 John", "3 John", "Jude", "Revelation") End Sub 'Sequentially searches the list of Bible books to conver the book into a number for sort purposes Function BookNumber(bk as String) as Integer Dim i as Integer If bk = "" then BookNumber = 67 Exit Function End If for i=0 to 65 if Bible(i) = bk then Exit For next i BookNumber = i End Function 'Splits the line of text into the elements of the "stuff" array Sub SplitText(i as Integer) Dim txt,book,chap,verse as String dim c as Integer txt = stuff(i,S_TEXT) c = instr(txt,chr(9)) 'Alternatively the string will be empty or a completely invalid reference. If c > 0 Then stuff(i,S_PAGE) = Val(Mid(txt,c+1)) txt = Left(txt,c-1) stuff(i,S_PASSAGE) = txt Else stuff(i,S_PAGE) = 0 End If c = instr(3,txt," ") If c > 0 then book = Left(txt,c-1) Else book = "" End If txt = Mid(txt,c+1) stuff(i,S_BOOK) = BookNumber(book) c = instr(txt,":") if c > 0 then stuff(i,S_CHAPTER) = Val(Left(txt,c-1)) txt = Mid(txt,c+1) c = instr(txt,"-") if c = 0 then c = instr(txt,"f") if c <> 0 then txt = left(txt,c-1) stuff(i,S_VERSE) = Val(txt) else stuff(i,S_CHAPTER) = Val(txt) stuff(i,S_VERSE) = 0 end if End Sub 'In sorting I swap everything but the TextElement object, then put the sorted strings into the unsorted 'TextElement objects to create the fully sorted list Sub Swap(i as Integer,j as Integer) Dim temp(6) Dim k as Integer 'code to swap two elements of stuff here for k = 1 to 6 temp(k) = stuff(i,k) next k for k=1 to 6 stuff(i,k) = stuff(j,k) next k for k = 1 to 6 stuff(j,k) = temp(k) next k End Sub 'The main routine. Run this from the Macros menu (or create whatever means of starting it you wish) Sub Paragraphs Dim Doc As Object Dim Enum As Object Dim TextElement As Object Dim p, cnt, idx,k as Integer Dim psg, txt as String InitializeBible() Doc = StarDesktop.CurrentComponent Enum = Doc.Text.createEnumeration p = 0 cnt = 0 idx = 0 While Enum.hasMoreElements TextElement = Enum.nextElement If TextElement.supportsService("com.sun.star.text.Paragraph") Then if p = 1 then cnt = cnt + 1 stuff(idx,S_TEXT) = TextElement.String stuff(idx,S_OBJ) = TextElement SplitText(idx) idx = idx + 1 else 'This is the major change. Rather than counting instances of 'Scripture Index I just look for the paragraph that is Scripture Index 'and nothing else, and that is the title. Sort everything after that. 'Note that this still will not handle anything after the index. if TextElement.String = "Scripture Index" Then p = 1 End If End If Wend k = idx - 1 'Sorts the list QSort(0,k) 'Sets the sorted strings into the correct TextElements and blanks out the passage on multiple entries 'for the same passage psg = "" for p=0 to k If psg <> stuff(p,S_PASSAGE) Then psg = stuff(p,S_PASSAGE) Else txt = stuff(p,S_TEXT) txt = Mid(txt,InStr(txt,Chr(9))) stuff(p,S_TEXT) = txt End If stuff(p,S_OBJ).String = stuff(p,S_TEXT) next p MsgBox "Finished" End Sub 'Comparison based on book number, then chapter, then verse, then the text of the passage reference 'which orders verses like Psalm 8:5-7 or 2 Timothy 3:16ff, then finally by the page number Function Comp(i as Integer, j as Integer) as Integer if stuff(i,S_BOOK) <> stuff(j,S_BOOK) then Comp = stuff(i,S_BOOK) - stuff(j,S_BOOK) Exit Function End If if stuff(i,S_CHAPTER) <> stuff(j,S_CHAPTER) then Comp = stuff(i,S_CHAPTER) - stuff(j,S_CHAPTER) Exit Function End If If stuff(i,S_VERSE) <> stuff(j,S_VERSE) Then Comp = stuff(i,S_VERSE) - stuff(j,S_VERSE) Exit Function End If If stuff(i,S_PASSAGE) > stuff(j,S_PASSAGE) Then Comp = 1 Exit Function ElseIf stuff(i,S_PASSAGE) < stuff(j,S_PASSAGE) Then Comp = -1 Exit Function End If Comp = stuff(i,S_PAGE) - stuff(j,S_PAGE) End Function 'I use a QSort just because I had one I'd written in C++ to convert. Sub QSort(left as Integer, right as Integer) Dim i, last as Integer if left >= right Then Exit Sub Swap(left,(left+right)/2) last = left for i=left+1 to right if Comp(left,i) > 0 then last = last + 1 Swap(last,i) end if next i Swap(left,last) QSort(left,last-1) QSort(last+1,right) End Sub
This should still be regarded as alpha!