主页 / coding / 问题 / 79173622
Accepted
traveh
Asked: 2024-11-10 04:16:32 +0800 CST

如何在 VBA 脚本中删除 MS Word 表格行中的最后一段

  • 772

我正在尝试编写一个 VBA 脚本，用于对 Microsoft Word 表格行内的所有 2 级多列表项进行随机排序。我使用的是最新版本的 MS Word (Office 365)。

我几乎做对了，但我的脚本重新插入了行，但添加了一个额外的列表项。我设法从最后一段（最后一行）中删除了列表项编号，但我似乎无法删除段落本身。

我尝试选择最后一段并删除（这会删除该行的全部内容），我试过了para.Range.Delete- 这似乎没有任何作用。

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 个回答

  1. Best Answer

    请尝试

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

    Microsoft 文档：

    Characters.Last 属性（Word）

    如果脚本不起作用，请分享您的表格布局和示例文本。

    在此处输入图片描述

    • 1

  2. 也许：

    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

相关问题