Forum Discussion

Gilgamesh1964's avatar
Gilgamesh1964
Brass Contributor
Oct 26, 2022
Solved

How would I extract paragraph/list numbers and the paragraph text in VBA

Hello,

I want like to have a VBA macro that will set a string for the paragraph/list number for every paragraph in the document along with a string for the text. For paragraphs that do not have a number then the first string should be empty.

 

For a document that might contain the following text:

1 This is a numbered heading

1.1 This is also a numbered heading

1.1.1 This is a paragraph that has a number on it

This is a paragraph that does not have a number on it

  1. This is a level 1 list entry

          (a) This is a level 2 list entry

 

I would be hoping to get the following

String 1

String 2

1

This is a numbered heading

1.1

This is also a numbered heading

1.1.1

This is a paragraph that has a number on it

 

This is a paragraph that does not have a number on it

1

This is a level 1 list entry

(a)

This is a level 2 list entry

 

I am fairly competent with VBA on Excel and Project but I have barely touched Word.

So, if someone could direct me to the appropriate Word objects and fields I would need I would appreciate it.

 

Thanks in advance

office 365

3 Replies

Sort By
  • Doug_Robbins_Word_MVP's avatar
    Doug_Robbins_Word_MVP
    MVP
    Oct 26, 2022

    Gilgamesh1964 Run a macro containing the following code when you have the document open

     

     

     

    Dim docsource As Document, doctarget As Document
Dim i As Long
Dim tbl As Table
Dim newrow As Row
Set docsource = ActiveDocument
Set doctarget = Documents.Add
With doctarget
    Set tbl = .Tables.Add(Selection.Range, 1, 2)
    With tbl
        .Cell(1, 1).Range.Text = "String 1"
        .Cell(1, 2).Range.Text = "String 2"
    End With
End With
With docsource
    .ConvertNumbersToText
    For i = 1 To .Paragraphs.Count
        Set newrow = tbl.Rows.Add
        If Left(.Paragraphs(i).Style, 7) = "Heading" Then
            With newrow
                .Cells(1).Range.Text = Left(docsource.Paragraphs(i).Range.Text, InStr(docsource.Paragraphs(i).Range.Text, vbTab) - 1)
                .Cells(2).Range.Text = Mid(docsource.Paragraphs(i).Range.Text, InStr(docsource.Paragraphs(i).Range.Text, vbTab) + 1)
            End With
        Else
            newrow.Cells(2).Range.Text = .Paragraphs(i).Range.Text
        End If
    Next i
    .Close wdDoNotSaveChanges
End With
doctarget.Activate

Resources