Início / coding / Perguntas / 79173622
Accepted
traveh
Asked: 2024-11-10 04:16:32 +0800 CST

Como excluir o último parágrafo de uma linha de tabela do MS Word em um script VBA

  • 772

Estou tentando escrever um script VBA que embaralha todos os itens multi-lista de nível 2 dentro de uma linha de tabela do Microsoft Word. Estou usando a versão mais recente do MS Word (Office 365).

Eu quase acertei, mas meu script reinsere as linhas, mas adiciona um item de lista extra. Consegui remover o número do item de lista do último parágrafo (a última linha), mas não consigo me livrar do parágrafo em si.

Tentei selecionar o último parágrafo e removê-lo (o que exclui todo o conteúdo da linha). Tentei para.Range.Delete, mas isso não parece fazer nada.

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
vba

2 respostas

  1. Best Answer

    Por favor tente

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

    Documentação da Microsoft:

    Caracteres.Última propriedade (Word)

    Por favor, compartilhe o layout da sua tabela com um texto de exemplo se o script não funcionar.

    insira a descrição da imagem aqui

    • 1

  2. Talvez:

    Sub Func()
Application.ScreenUpdating = False
Dim Para As Paragraph, ArrTmp(), i As Long, j As Long, k As Long
With Selection
  If .Information(wdWithInTable) = False Then
    MsgBox "Please place the cursor inside a table."
    Exit Sub
  End If
  With .Rows(1).Range
    ' Get the text
    For Each Para In .Paragraphs
      With Para.Range
        If .ListFormat.ListLevelNumber = 2 Then
          .End = .End - 1: k = k + 1
          ReDim Preserve ArrTmp(k)
          ArrTmp(k) = .Text
        End If
      End With
    Next
    ' Shuffle the array
    Randomize
    For i = 1 To k
      j = Int((k - i + 1) * Rnd + i)
      ArrTmp(0) = ArrTmp(i): ArrTmp(i) = ArrTmp(j): ArrTmp(j) = ArrTmp(0)
    Next
    k = 0
    ' Set the text
    For Each Para In .Paragraphs
      With Para.Range
        If .ListFormat.ListLevelNumber = 2 Then
          .End = .End - 1: k = k + 1
          .Text = ArrTmp(k)
        End If
      End With
    Next
  End With
End With
Application.ScreenUpdating = True
End Sub
    • 0

relate perguntas