burtburt
04-30-2008, 03:06 PM
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:
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
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.
'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
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.
"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:
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
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.
'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
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.