vbams-word

How to delete the last paragraph in an MS Word table row in a VBA script


I'm trying to write a VBA script that shuffles all level 2 multi-list items inside a Microsoft Word table row. I'm using the latest MS Word version (Office 365).

I almost got it right, but my script reinserts the lines but adds an extra list item. I managed to remove the list item number from the last paragraph (the last line), but i can't seem to get rid of the paragraph itself.

I tried selecting the last paragraph and removing (which deletes the whole contents of the row), I tried para.Range.Delete - this doesn't seem to do anything.

Sub Func()
    Dim tbl As Table
    Dim curRow As Row
    Dim para As Paragraph
    Dim paras() As String
    Dim cnt As Integer
    Dim i As Integer, j As Integer
    Dim temp As String

    If Not Selection Is Nothing And Selection.Tables.Count > 0 Then
        Set tbl = Selection.Tables(1)
        Set curRow = Selection.Rows(1)
    Else
        MsgBox "Please place the cursor inside a table."
        Exit Sub
    End If

    ' Count the number of list level 2 items
    cnt = 0
    For Each para In curRow.Range.Paragraphs
        If para.Range.ListFormat.ListLevelNumber = 2 Then
            cnt = cnt + 1
        End If
    Next para
    
    ' Collect the items in an array and remove them from the list
    ReDim paras(1 To cnt)
    cnt = 0
    For Each para In curRow.Range.Paragraphs
        If para.Range.ListFormat.ListLevelNumber = 2 Then
            cnt = cnt + 1
            paras(cnt) = para.Range.Text
            para.Range.Text = ""
        End If
    Next para

    ' Shuffle the array
    Randomize
    For i = 1 To cnt - 1
        j = Int((cnt - i + 1) * Rnd + i)
        temp = paras(i)
        paras(i) = paras(j)
        paras(j) = temp
    Next i

    ' Insert shuffled items back as level 2 list entries
    For i = 1 To cnt
        curRow.Range.InsertAfter paras(i)
    Next i
    
    Set para = curRow.Range.Paragraphs(curRow.Range.Paragraphs.Count - 1)
    para.Range.ListFormat.RemoveNumbers
    ' para.Range.Delete - doesn't do anything
    
End Sub

Solution

  • Pls try

        Set para = curRow.Range.Paragraphs(curRow.Range.Paragraphs.Count - 1)
        para.Range.ListFormat.RemoveNumbers
        para.Range.Characters.Last.Previous.Delete  ' ** add ** '
    

    Microsoft documentation:

    Characters.Last property (Word)

    Please share your table layout with sample text if the script doesn't work.

    enter image description here