Hi Jana,
You need to be patient - Answering forums questions is not all I do. Try the following:
Code:
Sub InsertRefs()
Application.ScreenUpdating = False
Dim RngHdA As Range, RngHdB As Range, RngRef As Range, oPara As Paragraph
Dim oSty As Style, StrStyList As String, strStyA, strStyB, StrTxt As String
Dim Msg As String, MsgA As String, MsgB As String, MsgErr As String
With ActiveDocument
StrStyList = "|"
MsgA = "What is the 'Main' Style to Find"
MsgB = "What is the 'Sub' Style to Find"
MsgErr = "No Such Style in this document" & vbCr
For Each oSty In .Styles
StrStyList = StrStyList & oSty.NameLocal & "|"
Next
Msg = MsgA
While strStyA = ""
strStyA = InputBox(Msg, "Style Selector")
If strStyA = "" Then Exit Sub
If InStr(StrStyList, "|" & strStyA & "|") = 0 Then
strStyA = ""
Msg = MsgErr & MsgA
End If
Wend
Msg = MsgB
While strStyB = ""
strStyB = InputBox(Msg, "Style Selector")
If strStyB = "" Then Exit Sub
If InStr(StrStyList, "|" & strStyB & "|") = 0 Then
strStyB = ""
Msg = MsgErr & MsgB
End If
Wend
End With
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Style = strStyA
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
Set RngHdA = .Paragraphs(1).Range.Duplicate
With RngHdA
On Error GoTo ParaLast
While .Paragraphs.Last.Next.Style <> strStyA
.MoveEnd wdParagraph, 1
Wend
ParaLast:
If .Paragraphs.Count > 2 Then
Set RngRef = RngHdA.Paragraphs(3).Range.Characters.Last
.MoveStart wdParagraph, 3
Set RngHdB = RngHdA
With RngRef
.MoveEnd wdCharacter, -2
For Each oPara In RngHdB.Paragraphs
If oPara.Style = strStyB Then
If Len(Trim(oPara.Range.Text)) > 1 Then
StrTxt = StrTxt & Left(oPara.Range.Text, Len(oPara.Range.Text) - 1) & ", "
End If
End If
Next
If Len(StrTxt) > 0 Then
StrTxt = "{" & Left(StrTxt, Len(StrTxt) - 2) & "}"
.InsertAfter StrTxt
End If
End With
End If
End With
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub
As I said before:
Quote:
There may be problems, though, if the code should not include sub Styles if they occur after some other Style that is not the main Style.
|
This could mean that if you have:
HTML Code:
Heading 1
some text
Heading 2
some text
Heading 3
some text
Heading 1
some text
Heading 3
some text
and you are looking for 'Heading 2' (main) and 'Heading 3' (sub), the last 'Heading 3' will be reported for the 'Heading 2' when it shouldn't be. Let me know if this is a problem.