Solved: References to Captions and Liststrings

[burtburt]

Ok. Here's my latest issue. When I want to insert a new image, table or paragraph (with liststrings) all the crossreferencess in the doc are now wrong. For example

"Do this or that and see Figure 1, Table 2 and Paragraph 1.2.1"

is in my document to start with. Then I insert above this line a new figure 1, making the old figure 1 now figure 2. Pushing it down. A new table 1 making the old table 1 and 2 now table 2 and 3 respectively. A new paragraph 1.2.1 making the old 1.2.1 now 1.2.2.

So the text above should now read...

"Do this or that and see Figure 2, Table 3, and Paragraph 1.2.2"

I solved this for the paragraph liststring with the following code:

[VBA]
ActiveDocument.Bookmarks("Sect4_Rework").Select
Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
j = ActiveDocument.Range(0, Selection.Paragraphs(1).Range.End).Paragraphs.Count
ActiveDocument.Bookmarks("Sect5_Ref").Select
Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
k = ActiveDocument.Range(0, Selection.Paragraphs(1).Range.End).Paragraphs.Count

For i = k To j Step -1
If ActiveDocument.Paragraphs(i).Style = ActiveDocument.Styles("Paragraph 4") Or _
ActiveDocument.Paragraphs(i).Style = ActiveDocument.Styles("Paragraph 5") Then
strReplace = ActiveDocument.Paragraphs(i).Range.ListFormat.ListString
If strReplace <> "" Then
p = InStr(1, strReplace, ".", vbTextCompare)
q = InStr(p, strReplace, ".", vbTextCompare) + p
str2Find = Left(strReplace, p) & (Mid(strReplace, p + 1, q - p - 1) - 1) & _
Right(strReplace, Len(strReplace) - q + 1)
With Selection.Find
.Text = str2Find
.Replacement.Text = strReplace
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End If
End If
Next i
[/VBA]

But for figures and tables I want to skip paragraphs with the style "Caption" since I don't want to change the figure names, just the text that references it.

[VBA]
'Correct References
k = ActiveDocument.Range(0, Selection.Paragraphs(1).Range.End).Paragraphs.Count

For i = ActiveDocument.Paragraphs.Count To k Step -1
If ActiveDocument.Paragraphs(i).Style = ActiveDocument.Styles("Caption") Then
strReplace = ActiveDocument.Paragraphs(i).Range.Text
strReplace = Left(strReplace, Len(strReplace) - 1)
' Selection.Collapse
If Left(strReplace, 6) = "Figure" Then
str2Find = "Figure " & (Right(strReplace, Len(strReplace) - 7) - 1)
With Selection.Find
Do While .Execute(FindText:=str2Find, _
Forward:=True, _
Wrap:=wdFindStop) = True
If .Parent.Style <> ActiveDocument.Styles("Caption") Then
'Works great up to here!!!
' .Text = strReplace
Selection.Text = strReplace
End If
Loop
End With

End If
End If
Next i
[/VBA]

the .Text = strReplace doesn't actually replace my found text. The Selection.Text = strReplace does but it also changes the selection.find so that I can't find anything else.

Find is a tricky little bstrd.

[burtburt]

Well this is once again a built in Word feature... Hopefully this will help other's who may stumble on this one...

1. In the document, type the introductory text that begins the cross-reference.
   1. For example, type For more information, see
2. On the Insert menu, point to Reference, and then click Cross-reference.
3. In the Reference type box, click the type of item you want to refer to ? for example, a heading.
4. In the Insert reference to box, click the information you want inserted in the document ? for example, the heading text.
5. In the For which box, click the specific item you want to refer to ? for example, the heading for Chapter 6.
6. To allow users to jump to the referenced item, select the Insert as hyperlink check box.
7. If the Include above/below check box is available, you can select this check box to include information about the relative position of the referenced item.
8. Click Insert.

[fumei]

I am so pleased that you follow up and post for others what you find out yourself. It is appreciated and very good form.

Do not stop asking things...you seem good at finding things.

Good for you.

Comments.

"the .Text = strReplace doesn't actually replace my found text. The Selection.Text = strReplace does but it also changes the selection.find so that I can't find anything else.

Find is a tricky little bstrd."

LOL, yes it can be, but once you grasp it, it works quite properly. Let's look at it.

"the .Text = strReplace doesn't actually replace my found text."

No, it does not. Why? Because .Text is setting the property of whatever parent object the "." points to. Which is.......

Selection.Find. NOT the Selection, but Find. So......

Selection.Text does work.

Using Range may be better.

[burtburt]

Well I finally figured this out. sigh. Took way too long. should have let this go a while ago. But I finally go this to work. Can't say that I fully understand find yet but it works. I had to make my own boolean condition to know when I cycled through all my found texts. The catch here was that I didn't want to replace everything, only the text that didn't belong to a "Caption" style paragraph. Since that is the Figure that everthing is refering to. So here it goes:

[vba]
'Correct Text References for Figures
Dim boolFoundFinish As Boolean
Dim strFirstFind As String
Dim rngFoundText As Range

k = ActiveDocument.Range(0, Selection.Paragraphs(1).Range.End).Paragraphs.Count

Set rngFoundText = ActiveDocument.Range.Duplicate
For i = ActiveDocument.Paragraphs.Count To k Step -1
If ActiveDocument.Paragraphs(i).Style = ActiveDocument.Styles("Caption") Then
strReplace = ActiveDocument.Paragraphs(i).Range.Text
strReplace = Left(strReplace, Len(strReplace) - 1)
Selection.Collapse
If Left(strReplace, 6) = "Figure" Then
str2Find = "Figure " & (Right(strReplace, Len(strReplace) - 7) - 1)
boolFoundFinish = False
strFirstFind = ""
With rngFoundText.Find
.Text = str2Find
.Forward = True
.Wrap = wdFindContinue
Do While boolFoundFinish = False

.Execute

If .Parent.Style <> ActiveDocument.Styles("Caption") Then
'Not a caption so replace it
rngFoundText.Text = strReplace

'Even Better replace the text with a MS Word Cross Reference
rngFoundText.InsertCrossReference ReferenceType:="Figure", _
ReferenceKind:=wdOnlyLabelAndNumber, _
ReferenceItem:=Right(strReplace, Len(strReplace) - InStr(1, strReplace, " ", vbTextCompare)), _
InsertAsHyperlink:=True, IncludePosition:=False, _
SeparateNumbers:=False, SeparatorString:=" "

ElseIf strFirstFind = "" Then
'Capture the paragraph that indicates a loop
strFirstFind = CStr(ActiveDocument.Range(0, rngFoundText.Paragraphs(1).Range.End).Paragraphs.Count)
ElseIf strFirstFind = CStr(ActiveDocument.Range(0, rngFoundText.Paragraphs(1).Range.End).Paragraphs.Count) Then
'Found the loop paragraph a 2nd time. So we're done searching.
boolFoundFinish = True
End If

Loop
End With

End If
End If
Next i
[/vba]

I know this is loopy but it works. Bad part is if you delete a figure it's all screwed up again. Oh well, next phased release...