List Text that uses built-in style Heading 1 in a MsgBox

[andreas]

Dear Experts:

Below macro (courtesy of Lene Fredborg) lists the text that uses built-
in style Heading 1 in a new document.

I would like the macro changed with the following feature:

(1) list the text in a msgbox, not in a new document
(2) the outline numbering should also be listed (such as 1
Introduction, 2 Analysis, 3 Summary etc.)

I hope this is feasible. Thank you very much in advance for your
help.

Regards, Andreas



Sub ListHeading1Paras()
Dim oPara As Paragraph
Dim oDocH1 As Document
Dim oDoc As Document
Set oDoc = ActiveDocument
Set oDocH1 = Documents.Add
'Make sure oDocH1 starts empty and with style Normal
With oDocH1
.range = ""
.Paragraphs(1).Style = oDoc.Styles(wdStyleNormal)
End With
'Iterate through all paragraphs in active document
'If style is Heading 1, insert text in oDocH1
For Each oPara In oDoc.Paragraphs
If oPara.Style = oDoc.Styles(wdStyleHeading1) Then
oDocH1.range.InsertAfter oPara.range.Text
End If
Next oPara
'Clean up
Set oDoc = Nothing
Set oDocH1 = Nothing
End Sub

 

[Lene Fredborg]

I think the following version will do what you want:

Sub ListHeading1Paras_MSG()
Dim oPara As Paragraph
Dim strMsg As String

'Create start of message
strMsg = "The document contains the following Heading 1 text:" & vbCr &
vbCr

'Iterate through all paragraphs in active document
'If style is Heading 1, append to message
For Each oPara In ActiveDocument.Paragraphs
If oPara.Style = ActiveDocument.Styles(wdStyleHeading1) Then
With oPara.Range
'Append the heading number and text to the message
strMsg = strMsg & .ListFormat.ListString & " " & .Text
End With
End If
Next oPara

'Show message
MsgBox strMsg, vbOKOnly, "Heading 1 Text"

End Sub

--
Regards
Lene Fredborg - Microsoft MVP (Word)
DocTools - Denmark
www.thedoctools.com
Document automation - add-ins, macros and templates for Microsoft Word

 

[andreas]

I think the following version will do what you want:

Sub ListHeading1Paras_MSG()
    Dim oPara As Paragraph
    Dim strMsg As String

    'Create start of message
    strMsg = "The document contains the following Heading 1 text:" & vbCr &
vbCr

    'Iterate through all paragraphs in active document
    'If style is Heading 1, append to message
    For Each oPara In ActiveDocument.Paragraphs
        If oPara.Style = ActiveDocument.Styles(wdStyleHeading1)Then
            With oPara.Range
                'Append the heading number and text to the message
                strMsg = strMsg & .ListFormat.ListString & " " & .Text
            End With
        End If
    Next oPara

    'Show message
    MsgBox strMsg, vbOKOnly, "Heading 1 Text"

End Sub

--
Regards
Lene Fredborg - Microsoft MVP (Word)
DocTools - Denmarkwww.thedoctools.com
Document automation - add-ins, macros and templates for Microsoft Word











- Show quoted text -

Dear Lene,

very nice piece of coding. I just tried it out. Exactly what I wanted.
Thank you very much for your professional help. Regards, Andreas

 

[Lene Fredborg]

You are welcome. I am glad i could help.

--
Regards
Lene Fredborg - Microsoft MVP (Word)
DocTools - Denmark
www.thedoctools.com
Document automation - add-ins, macros and templates for Microsoft Word