Making AutoxRrefs in Word 2007?

[bcn]

Hi,

The following code, from "Word Hacks: Tips & Tools for Taming Your Text", automatically cross-references the selected text to any heading with identical content. I've been trying to tweak it in order to automatically cross-reference a figure caption with identical content, with no success. The idea is that if the user selects "Figure 3-5" in any line of text (such as in a paragraph that says "For more info, see Figure 3-5"), the code should look for the corresponding figure and automatically cross-reference to it.
Any ideas on how to do this would be highly appreciated!


Sub MakeAutoXRef()
Dim sel As Selection
Dim rng As range
Dim para As Paragraph
Dim doc As Document
Dim sBookmarkName As String
Dim sSelectionText As String
Dim lSelectedParaIndex As Long
Set sel = Selection
Set doc = sel.Document
If sel.range.Paragraphs.Count <> 1 Then Exit Sub
lSelectedParaIndex = GetParagraphIndex(sel.range.Paragraphs.First)
sel.MoveStartWhile cset:=(Chr$(32) & Chr$(13)), Count:=sel.Characters.Count
sel.MoveEndWhile cset:=(Chr$(32) & Chr$(13)), Count:=-sel.Characters.Count
sSelectionText = sel.text
For Each para In doc.Paragraphs
Set rng = para.range
rng.MoveStartWhile cset:=(Chr$(32) & Chr$(13)), _
Count:=rng.Characters.Count
rng.MoveEndWhile cset:=(Chr$(32) & Chr$(13)), _
Count:=-rng.Characters.Count
If rng.text = sSelectionText Then
If Not GetParagraphIndex(para) = lSelectedParaIndex Then
sBookmarkName = GetOrSetXRefBookmark(para)
If Len(sBookmarkName) = 0 Then
MsgBox "Couldn't get or set bookmark"
Exit Sub
End If
sel.InsertCrossReference _
referencekind:=wdContentText, _
referenceItem:=doc.Bookmarks(sBookmarkName), _
referencetype:=wdRefTypeBookmark, _
insertashyperlink:=True
Exit Sub
Else
MsgBox "Can't self reference!"
End If
End If
Next para
End Sub

Function RemoveInvalidBookmarkCharsFromString(ByVal str As String) As String
Dim i As Integer
For i = 33 To 255
Select Case I
Case 33 To 47, 58 To 64, 91 To 96, 123 To 255
str = Replace(str, Chr(i), vbNullString)
End Select
Next i
RemoveInvalidBookmarkCharsFromString = str
End Function

Function ConvertStringRefBookmarkName(ByVal str As String) As String
str = RemoveInvalidBookmarkCharsFromString(str)
str = Replace(str, Chr$(32), "_")
str = "_" & str
str = "XREF" & CStr(Int(90000 * Rnd + 10000)) & str
ConvertStringRefBookmarkName = str
End Function

Function GetParagraphIndex(para As Paragraph) As Long
GetParagraphIndex = _
para.range.Document.range(0, para.range.End).Paragraphs.Count
End Function

Function GetOrSetXRefBookmark(para As Paragraph) As String
Dim i As Integer
Dim rng As range
Dim sBookmarkName As String
If para.range.Bookmarks.Count <> 0 Then
For i = 1 To para.range.Bookmarks.Count
If InStr(1, para.range.Bookmarks(i).name, "XREF") Then
GetOrSetXRefBookmark = para.range.Bookmarks(i).name
Exit Function
End If
Next i
End If
Set rng = para.range
rng.MoveEnd unit:=wdCharacter, Count:=-1
sBookmarkName = ConvertStringRefBookmarkName(rng.text)
para.range.Document.Bookmarks.Add _
name:=sBookmarkName, _
range:=rng
GetOrSetXRefBookmark = sBookmarkName
End Function

[macropod]

I'm not keen on trying to maintain someone else's code. Have you contacted "Word Hacks" for help?

FWIW, it appears the code looks for an entire paragraph containing exactly what you have selected. Captions usually have more than just 'Figure #'.

[bcn]

Hi Paul,

Drawing your attention to one's thread (getting an answer from you) is like winning the lottery. You seem to be ubiquitous, but I never had that luck before. I was even trying to contact you since months to no avail. But now that I get your attention, there is no answer. :(

I was able to get this as a tweak. But disgracefully it doesn't do the trick.

Best,

Daniel


Sub findToReference()
Dim whatTo As range
Set whatTo = Selection.range
Dim whatToTxt As String
whatToTxt = whatTo.text
Dim sBookmarkName As String
Dim rngDoc As range
Set rngDoc = ActiveDocument.Content
With rngDoc.Find
.text = whatTo
.Style = "Caption" 'style name
.Execute
End With
If rngDoc.Find.Found = True Then
rngDoc.Select 'select found string
sBookmarkName = GetOrSetXRefBookmark(rngDoc)
'copy from previous
If Len(sBookmarkName) = 0 Then
MsgBox "Couldn't get or set bookmark"
Exit Sub
End If
whatTo.InsertCrossReference _
referencetype:=wdRefTypeBookmark, _
referencekind:=wdContentText, _
referenceItem:=rngDoc.Bookmarks(sBookmarkName), _
insertashyperlink:=True
Else
MsgBox "No headers matching selection found!"
End If
End Sub


Function RemoveInvalidBookmarkCharsFromString(ByVal str As String) As String
Dim i As Integer
For i = 33 To 255
Select Case I
Case 33 To 47, 58 To 64, 91 To 96, 123 To 255
str = Replace(str, Chr(i), vbNullString)
End Select
Next i
RemoveInvalidBookmarkCharsFromString = str
End Function


Function ConvertStringRefBookmarkName(ByVal str As String) As String
str = RemoveInvalidBookmarkCharsFromString(str)
str = Replace(str, Chr$(32), "_")
str = "_" & str
str = "XREF" & CStr(Int(90000 * Rnd + 10000)) & str
ConvertStringRefBookmarkName = str
End Function


Function GetParagraphIndex(para As Paragraph) As Long
GetParagraphIndex = _
para.range.Document.range(0, para.range.End).Paragraphs.Count
End Function


Function GetOrSetXRefBookmark(paraRng As range) As String
Dim i As Integer
Dim rng As range
Dim sBookmarkName As String
sBookmarkName = ConvertStringRefBookmarkName(paraRng.text)
paraRng.Bookmarks.Add _
name:=sBookmarkName, _
range:=paraRng
GetOrSetXRefBookmark = sBookmarkName
End Function

[bcn]

Basically, when I debug with F8, and stop at


If rngDoc.Find.Found = True Then

It shows True = True. But then, if I press F8 again, it jumps to


Else
MsgBox "No headers matching selection found!"

[macropod]

It seems to me you could do what you want with:

Sub InsertCaptionRef()
Application.ScreenUpdating = False
Dim RngSel As Range
Set RngSel = Selection.Range
If Trim(RngSel.Text) = "" Then Exit Sub
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = Selection.Text
.Style = "Caption"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
If .Find.Found = True Then
RngSel.InsertCrossReference ReferenceType:=wdCaptionFigure, _
ReferenceKind:=wdOnlyLabelAndNumber, _
ReferenceItem:=.Duplicate.Words.Last.Text, InsertAsHyperlink:=True
End If
End With
Application.ScreenUpdating = True
End Sub

[bcn]

Paul,

You are great!!! Thank you very much for your help!!!

Please let me abuse of your kindness with two more questions:

1. I've been trying to add a line to make the macro apply a style (let's call it "xyz" style) to the "Figure 3-1" in the regular text (not in the caption) after or before the cross-reference is created. But my line, which I'm adding immediately before the last End If, does not work (my understanding of BVA is still very poor):

RngSel.Style = ActiveDocument.Styles("xyz")
Which is the correct statement and where should I place it?

2. What if I want to do the same process with Table captions? Say, have the user select "Table 2-1" and make a cross-reference to the Table 2-1 caption. Is there a simple way to replace the code in the current Find and Fine.Found?

Thanks a lot again!!!

[macropod]

#1 is as simple as:
RngSel.Style = "xyz"
If you prefer, you can put it inside the If ... End If block, so that it only gets applied if the corresponding caption is found.

#2 requires no code changes - it works with any kind of caption. Even a cursory reading of the code would show that it doesn't refer to a particular kind of caption.

[bcn]

Hi Paul,

# 1 RngSel.Style = "xyz" does not work for some reason. I think it is related to what is selected in that moment. I could only make it work with the following. But don't know if it is a reliable solution.


Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
Selection.Style = ActiveDocument.Styles("xyz")

#2 The problem is that the table captions have a style called "Table Caption" (as opposed to the "Caption" style for figure captions). So it does not work unless I change this line to:


.Style = "Table Caption"
Is there a way to tell the code to look for one or the other ("Caption" and "Table Caption") and then act accordingly?

Thanks!

[macropod]

Re #1. What kind of Style is "xyz"? If it's a character Style, and you need to apply that to the field result, you'll need to modify the field code to apply the Style to the 'R' in the field's 'REF' string, add a '\* Charformat' switch to the field and delete any '\* Mergeformat' switch the field may already have. That requires a fair bit more code.

Re #2. When I create any of Equation, Figure or Table caption, Word assigns the same Style to each of them - 'Caption'.

[bcn]

Hi Paul.

Re #1. The "xyz" style is a character style. In real life, it is called "See". So when you have something like "(see Figure 4-2)" I would like to be able to select "Figure 4-2", convert it into a cross reference targeting the "Figure 4-2" in the caption, and then applying the "See" style to the cross reference.

Re #2. Ok, so maybe I'm getting something wrong here. I use the built-in "Caption" style for Figure captions, which are placed below the figure and centered, with a certain font size. Since the captions for tables should appear on top of the table, left aligned and with a different font size, I created "Table Caption" for that. Is this not the logical way to procede?

[macropod]

Re #1. As I said regarding the use of character Styles, some extra code is required.

Re #2. It would have been good if you'd said you were using a a non-standard Style up front, instead of trotting that info out when the code didn't work as desired - you can't expect anyone to code for what you don't say or that code designed to work with the standard Style will 'notice' that you're doing something different.

Try:

Sub InsertCaptionRef()
Application.ScreenUpdating = False
Dim RngSel As Range, FldRng As Range
Set RngSel = Selection.Range
If Trim(RngSel.Text) = "" Then Exit Sub
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = RngSel.Text
If Trim(RngSel.Words.First.Text) = "Table" Then
.Style = "Table Caption"
Else
.Style = "Caption"
End If
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
If .Find.Found = True Then
RngSel.InsertCrossReference ReferenceType:=wdCaptionFigure, _
ReferenceKind:=wdOnlyLabelAndNumber, _
ReferenceItem:=.Duplicate.Words.Last.Text, InsertAsHyperlink:=True
RngSel.MoveEnd wdWord, 1
With RngSel.Fields(1)
With .Code.Words
.First.Next.Style = "See"
.Last.Previous.InsertBefore "\* Charformat "
End With
.Update
End With
End If
End With
Application.ScreenUpdating = True
End Sub

[bcn]

Hi Paul,

I apologize for the misunderstanding and the extra work I've given you. At the very beginning I was not aware that I also needed to target the "Table Caption" style. That's why I later addded "And what if I cwould also like to...?" Sorry for that.

Thank you for the edited code. But it does not work as intended. If I select "Table 2-1" and run the code, it converts it into a cross reference with the "See" style, but changes the text to "Figure 3-1". I suppose this is related to the use of ReferenceType:=wdCaptionFigure instead of ReferenceType:=wdCaptionTable. I was able to tweak the code with an ELSE IF statement. It seems to work. Please let me know if it makes sense. I ask this because I don't know why with your code it inserts "Figure 3-1". It's the only Figure in the dummy file, but what if there were more? My logic says it should just be confused but not choose a specific figure. Thanks a lot again for all your efforts!


Sub InsertCaptionRef()
Application.ScreenUpdating = False
Dim RngSel As range, FldRng As range
Set RngSel = Selection.range
If Trim(RngSel.text) = "" Then Exit Sub
With ActiveDocument.range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.text = RngSel.text
If Trim(RngSel.Words.First.text) = "Table" Then
.Style = "Table Caption"
Else
.Style = "Caption"
End If
.Replacement.text = ""
.Forward = True
.Wrap = wdFindContinue
.format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
If .Find.Found = True Then
If .Find.Style = "Caption" Then
RngSel.InsertCrossReference ReferenceType:=wdCaptionFigure, _
ReferenceKind:=wdOnlyLabelAndNumber, _
referenceItem:=.Duplicate.Words.Last.text, InsertAsHyperlink:=True
Else
RngSel.InsertCrossReference ReferenceType:=wdCaptionTable, _
ReferenceKind:=wdOnlyLabelAndNumber, _
referenceItem:=.Duplicate.Words.Last.text, InsertAsHyperlink:=True
End If
RngSel.MoveEnd wdWord, 1
With RngSel.Fields(1)
With .Code.Words
.First.Next.Style = "See"
.Last.Previous.InsertBefore "\* Charformat "
End With
.Update
End With
End If
End With
Application.ScreenUpdating = True
End Sub

[macropod]

OK, try:

Sub InsertCaptionRef()
Application.ScreenUpdating = False
Dim RngSel As Range, StrCptn As String
Set RngSel = Selection.Range
If Trim(RngSel.Text) = "" Then Exit Sub
StrCptn = Trim(RngSel.Words.First.Text)
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = RngSel.Text
If StrCptn = "Table" Then
.Style = "Table Caption"
Else
.Style = "Caption"
End If
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
If .Find.Found = True Then
RngSel.InsertCrossReference ReferenceType:=StrCptn, _
ReferenceKind:=wdOnlyLabelAndNumber, _
ReferenceItem:=.Duplicate.Words.Last.Text, InsertAsHyperlink:=True
RngSel.MoveEnd wdWord, 1
With RngSel.Fields(1)
With .Code.Words
.First.Next.Style = "See"
.Last.Previous.InsertBefore "\* Charformat "
End With
.Update
End With
End If
End With
Application.ScreenUpdating = True
End Sub

[bcn]

Works a charm, Paul!!! Thank you very much!!!
I was not aware of that reference type. Is that some kind of wild card for all types of captions?

Paul, let me ask you something else, if you don't mind. Some times, when I'm working with some of the many macros I have in my template, I get a blue empty Word window which I cannot close. I have the feeling that this is related to not using the screen updating in some of the macros. How do I know where shhould i apply them and where not? Can I apply them to my Private Sub Document_Open() which in turn calls 3 or 4 macros?

Thanks a lot again!

D

[macropod]

If you look at how I've used StrCptn, you'll find it's merely a string variable that I defined, then populated on the basis of the first word in the selection.

Regarding your second problem, it could be that you've exited the macro with no document visible - or a ScreenUpdating issue. With your 'Document_Open' macro, all you should need to have is 'Application.ScreenUpdating = False' at the start and 'Application.ScreenUpdating = True' at the end. The macros called by it don't need either.

[bcn]

Thank you very much, Paul. I am grateful and I feel honored by the time you've dedicated me.