Microsoft Office Forums - View Single Post

d4okeefe · 06-15-2018, 08:43 AM

I drew this up just now. Hope it helps.

As mention in the code comments, you need to add a reference to the Excel Object library. I use Office 2016, so my object library is named <Microsoft Excel 16.0 Object Library>. Yours may be slightly different -- something like <Microsoft Excel 11.0 Object Library>.

Code:

Sub find_no_5_and_paste_in_worksheet()
    ' Get text from list item 5 and subitems
    Dim d As Document: Set d = ActiveDocument
    Dim p As Paragraph
    Dim arr(1 To 100) As String
    Dim x As Integer: x = 1
    Dim five_found As Boolean
    
    For Each p In d.Paragraphs
        Dim lst_str As String
        lst_str = p.Range.ListFormat.ListString
        'p.Range.Select
        
        ' Adjust if necessary:
        ' In your list, "5." may look like "(5)" or "5)"
        If lst_str = "6." Then Exit For
        If lst_str = "5." Or five_found Then
            five_found = True
            arr(x) = p.Range.Text
            x = x + 1
        End If
    Next p
    
    ' open Excel and paste to worksheet for this to work, 
    ' you need a reference to <Microsoft Excel 16.0 Object Library>
    ' look in Tools -> References
    Dim obj As Excel.Application
    Set obj = New Excel.Application
    obj.Visible = True
    
    Dim wkbk As Excel.Workbook
    Set wkbk = obj.Workbooks.Add
    
    Dim wkst As Excel.Worksheet
    Set wkst = wkbk.ActiveSheet
    
    ' adjust the wkst.Cells(y, 1) assignment if you
    ' want this pasted somewhere else on the sheet
    ' y is the row, and 1 is the column
    Dim y As Integer
    For y = 1 To UBound(arr)
        If arr(y) <> "" Then
            'Debug.Print arr(y)
            wkst.Cells(y, 1) = arr(y)
        End If
    Next
End Sub