#16
|
|||
|
|||
Glad it is sort of working (What went wrong initially - do you know?)
For the 66 books this shouldn't be a problem In VBA the '_' at the end of a line is a line continuation character so you should be able to create the initial string by extending as follows Code:
Const LIST_OF_AUTHORITIES As String = "John, Matthew,Mark , Revelation," _ & "Genesis, Exodus , Judges, " _ & " Book1, Book2, Book3, Book4, book5, book6, book7 " _ & "Book8, Book9, Book10, Book 11" etc If this doesn't work for you then just write a paragraph seperated list on an empty page at the end of your document and I write a sub to collect the reference names from there. The occasional . or ) embedded in your hyperlinks just means I've missed an edge case. I'll add some code to check for that. |
#17
|
|||
|
|||
Make the change as per the red line below and let me know how you get on
Code:
Case SPACE, SEMI_COLON, POINT, RBRACKET rng.MoveEndWhile cset:=AFTER_A_NUMBER, Count:=wdBackward |
#18
|
|||
|
|||
Hi,
I was not processing the macro properly..it was me!!! I have added the changed code, but think that the script is stopping from something else. When I run it it seems to only sporadically pick out any book in the first line of the LIST_OF_AUTHORITIES and hyperlink these, it seems to ignore all the other lines with the books in them. I have 65 pages of text and it stops at about 6, with the messages box "Oops. We found..." it does this about 6 times before crashing out. Any ideas...please... |
#19
|
|||
|
|||
Quote:
Quote:
But if you can wait until later today I'll revise the code so it just highlights non conforming references. |
#20
|
|||
|
|||
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 |
#21
|
|||
|
|||
As I suspected you have some 'malformed references which are causing problems.
e.g. in 4:10 Leviticus 14:5, the is interpreted as two hyperlinks because we think we have discovered a rule that says references that end with a ',' are followed by another reduced format reference. e.g. Leviticus 14:5, 24; So this means either you will have to check your references and ensure that they are consistent or wait a further couple of days whilst I ponder on changes to Make. The problem is that I'm travelling over the next couple of days so probably won't be able to get back to this until Sunday at least. |
#22
|
|||
|
|||
Hey thanks for spending the time you have.
No worries about waiting, as what you have done will be saving me ours of work in the future... Hope its not to complex for you to complete? thanks |
#23
|
|||
|
|||
I had a lucky break and found myself with some time.
The code below processes your test document without stopping. There are several references that it identified as malformed. Typically this is because the - in the reference in an em dash rather than a hyphen. I've changed the code so that you don't have to include the authorities in the code itself. Instead just create a document called Authorities.docx. Place a comma seperated list of the authorities in the document and save it in the same directory as document you want to process. This is the list I ended up with from you post above. Quote:
If you want to change references such as 1John to John 1 the code will accept this as written but it depends on how your hyperlink targets are structured. I had some trouble with John as an authority as it was like the code ignored the presence of the name, hence the reason for it appearing twice in my list. Here's the updated code Code:
Option Explicit ' Note the use of module scope constants and variable ' Constants used with the authorities and authority_ref arrays 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 DO_NOT_SAVE As Boolean = False ' Constants representing characters 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 = "." 'Constants used with cset Note cset doesn't support ranges e.g."[0-9]" Const IS_A_NUMBER As String = "0123456789" Const END_OF_REFERENCE As String = vbLf & vbCr & "[ ),.;]" 'Constants used when forming hyperlinks 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\<authority>.htm#chpt_" Private authority_ref() As String Private found_strange_ref As Boolean Sub main() Dim authorities() As String Dim authority As Variant found_strange_ref = False populate_list_of_authorities authorities 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) = authority insert_authority_hyperlinks Next If found_strange_ref Then MsgBox "Malformed references were found. These have been highlighted in Red", vbOKOnly End If End Sub Sub populate_list_of_authorities(ByRef list() As String) ' Reads in the list of Authorities from a word document called 'authorities.docx' ' Dim list_text As String Dim authority_doc As Word.Document Set authority_doc = Documents.Open(ActiveDocument.Path & "\" & "Authorities.docx") list_text = authority_doc.Paragraphs(1).range.text authority_doc.Close DO_NOT_SAVE ' Process list text to get a standard representation ' e.g. This " John , Luke, Samuel 1, Revelations ,Genesis,." ' to this "John,Luke,Samuel 1,Revelations,Genesis" list_text = Trim$(list_text) list_text = replace(list_text, SPACE & SPACE, SPACE) list_text = replace(list_text, SPACE & COMMA, COMMA) list_text = replace(list_text, COMMA & SPACE, COMMA) list_text = replace(list_text, COMMA & COMMA, COMMA) list_text = replace(list_text, SEMI_COLON, COMMA) list_text = replace(list_text, COLON, COMMA) list_text = replace(list_text, HYPHEN, COMMA) Do While Not Right(list_text, 1) Like "[0-9a-zA-Z]" list_text = Left(list_text, Len(list_text) - 1) Loop list = Split(list_text, COMMA) 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]{1,})(:)([0-9]{1,})" 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 .Format = True .Font.ColorIndex = ActiveDocument.Styles(wdStyleNormal).Font.ColorIndex .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) Dim last_char As String last_char = rng.Next(unit:=wdCharacter, Count:=1) rng.Select Select Case last_char Case HYPHEN ' the reference isn't complete so we need to extend rng and then ' re-enter this sub extend_hyphen_reference_to_full_range rng process_single_hyperlink rng, hyperlink_type Case COMMA ' A comma at the end of a reference implies a following short form reference populate_authority_ref rng insert_hyperlink rng, FULL_HYPERLINK If move_range_to_following_short_form_ref(rng) Then ' Don't provide any message if we don't find a short form ref process_single_hyperlink rng, VERSE_ONLY_HYPERLINK End If Case vbLf, vbCr, SPACE, SEMI_COLON, COLON, POINT, RBRACKET populate_authority_ref rng insert_hyperlink rng, hyperlink_type Case Else rng.HighlightColorIndex = wdRed found_strange_ref = True End Select End Function Sub extend_hyphen_reference_to_full_range(rng As Word.range) rng.MoveEndUntil cset:=IS_A_NUMBER rng.MoveEndWhile cset:=IS_A_NUMBER End Sub Function move_range_to_following_short_form_ref(rng As Word.range) As Boolean ' we assume that the follow on range is quite close to avoid the error ' of there actually not being a following short form reference If rng.MoveStartUntil(cset:=IS_A_NUMBER, Count:=4) Then rng.MoveEndWhile cset:=IS_A_NUMBER move_range_to_following_short_form_ref = True Else move_range_to_following_short_form_ref = False End If End Function Sub populate_authority_ref(rng As Word.range) ' If the text of the range does not contain a colon then the reference is a short form ' and consequently we only need to populate VERSE_1 If InStr(rng.text, COLON) Then authority_ref(NAME) = get_substr(rng.text, SPACE, 0) authority_ref(CHAPTER) = get_substr(get_substr(rng.text, SPACE, 1), COLON, 0) authority_ref(VERSE_1) = get_substr(get_substr(rng.text, COLON, 1), HYPHEN, 0) If InStr(rng.text, HYPHEN) > 0 Then authority_ref(VERSE_2) = get_substr(get_substr(rng.text, COLON, 1), HYPHEN, 1) Else authority_ref(VERSE_2) = vbNullString End If Else authority_ref(VERSE_1) = rng.text End If End Sub Function get_substr(text, seperator, index) As String Dim list() As String If index < 0 Then get_substr = vbNullString ElseIf InStr(text, seperator) = 0 Then get_substr = text Exit Function End If list = Split(text, seperator) If UBound(list) < index Then get_substr = vbNullString Exit Function End If get_substr = list(index) 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 Incidentally, it would now be a trivial exercise to compile a dictionary of dictionaries in case you wanted to do any further processing with the hyperlinks. e.g. Print a list of references, list of hyperlinks, count the references for each authority etc. Let me know how it goes for you. |
#24
|
|||
|
|||
Hey WOW...thanks for that I will give it a try today and let you know.
|
#25
|
|||
|
|||
Hey, thanks for your work. I have tried it on the document in question and it takes about 30 seconds to run and returns near perfect results!! Just 2 that I can easily fix. How brilliant is that...
I know this is cheeky...but could I have a refinement? When it reaches a reference like John 3:12, 13 could this be one hyperlink, not separating the 12, 13, and a reference like John 21:20, 24 would be 2 as it already does? I have run this VBA on a few documents of many references and pages...its is great...thanks you so much you will save me hours of time. CR |
#26
|
|||
|
|||
That should be possible. Can you explain the difference between the two types of reference. They seem the same to me.
|
#27
|
|||
|
|||
So here is the first ref: Revelation 7:9, 10 this as you will see is completly underlined, illustrating one complete hyperlink. The second is: Matthew 24:29, 31 which is 2 hyperlinks one for Mathew 24:29 and one for 31.
Revelation 7:9, 10 Mathew 24:29, 31 Hope this makes sense! |
#28
|
|||
|
|||
From your additional examples it would seem that if the short form reference is +1 that in the main reference then you want a single hyperlink but if the short form reference is not +1 of the main reference you want two hyperlinks.
e.g. John 1:4,5 Matthew 5:12,13 should be single hyperlinks but john 1:4,6 Matthew 5:12,14 would be two hyperlinks To my eye this would indicate that references of the form John 1:4,5 are typographical errors as they should have been written as John 1:4-5 in the first instance. Is this understanding correct? |
#29
|
|||
|
|||
Yes I understand your assumption, however if the reference is for example John 15:1-3, this is correct, but would be correctly as another example John 15:1,2 would be correct. These both would be one hyperlink.
However as an example John 15:1,3 would be 2 hyperlinks. referring to 1 and then 3. This is how I import them into my documents. I hope this helps. I must say I didn't really think about the variations when asking for help!! Thanks. |
#30
|
|||
|
|||
Your explanation still isn't helping.
You've clarified that 1. John 15:1-3 is a single hyperlink 2. John 15:1,2 is a single hyperlink 3. John 15:1,3 is two hyperlinks (and is not the same as the reference John 15:1-3). So we need to find a way of differentiating cases 2 and 3 by code. The current rules for finding references are as follows 1. Search for a stem reference. A stem reference is an Authority name, followed by one or more spaces followed by one or more numbers terminating with a colon e.g. John 15: 2 look at the character after the range containing the reference. Depending on the character found we so one of 4 actions a. Hypen b,Comma c terminating character (semi-colon, period, space, right bracket d Character not included in a, b or c If we have case d it is a malformed reference so currently we highlight the reference in red and then continue from 1 If we have case c we insert the hyperlink and continue from 1 if we have case b we insert the hyperlink and then look for a short form reference (which is just a number). If we don't find a number we currently ignore the fact that there was a comma and continue from 1. If we do find a number then we insert a hyperlink which is constructed using the stem reference we found in 1 plus the current number. Based on the discussion so far I think I have to change the rules above as follows if we have case b Preserve the current reference range Look ahead to see if the comma is followed by spaces then a number ( a short form reference) Compare the verse number in the stem reference to the verse number in the short form reference. If the verse number in the short form reference is the verse number in the stem reference +1 then insert a single hyperlink using the stem reference and the short form reference Otherwise insert two separate hyperlinks. If the proposal above doesn't work then we are stuck as we have no way of programatically deciding what to do after we find a reference followed by a comma. |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
How to embed hyperlink to another document into an ActiveX Control Text Box | kenboy21 | Word VBA | 3 | 02-24-2017 09:41 PM |
Macro (or something) to run Spell Check within rich text content boxes in lock document | NMBELL | Word | 8 | 12-21-2015 04:09 PM |
Moving from hyperlink to hyperlink in a document | Bengt | Word VBA | 2 | 12-21-2015 12:42 AM |
Hyperlink: open the document only once, quit & reopen PP, hyperlink doesnt work anymore | quanghuynguyenhua | PowerPoint | 0 | 10-10-2015 06:17 PM |
Macro for word to add page break and specific text to end of document | pizzaman1 | Word VBA | 6 | 11-14-2014 11:25 PM |