使用标题移动文本

Question

我第一次在 Whosebug 上写问题，已经使用了 5 年多了！希望我没有错过另一个 post 中的答案，并且我会达到提问的标准：

我正在尝试根据用户输入动态移动 MS-word 文档中的文本，使用标题查找要移动的内容和移动位置。

举个例子，假设我的文档是这样组织的：

第 1 节第 2 节第三节附件一

将“第 1 节”、“第 2 节”、“第 3 节”和“附件”定义为标题 1 样式。

在每个部分（和附件）中，您都有混合批次的文本、表格、图片等。

让我们假设用户通过 VBA 被问到以下问题（通过按钮单击事件或文档打开事件触发，无关紧要 - 我知道该怎么做）。根据他们的回答，我想

a) 什么都不做

b) 执行以下操作：

select 整个“第 1 节”，包括标题和其中的所有文本、图形、表格等（换句话说 - 直到“第 2 节”开始）
将它移到第 3 节和附件 1 之间，这样文档结构现在如下所示：第 2 节第 3 节第 1 节附件 1

Dim answer as Integer

answer = MsgBox("Do you like cookies?", vbQuestion + vbYesNo + vbDefaultButton2, "The big question")

if answer = vbYes Then

' e.g. do nothing or end sub

else

' move text as described above

我当然探索/阅读了很多关于 selection.find、selection.move 和 range.move 方法的 post。

我已经到了可以使用以下代码找到并 select 我感兴趣的部分的阶段；


Dim answer as Integer

answer = MsgBox("Do you like cookies?", vbQuestion + vbYesNo + vbDefaultButton2, "The big question")

if answer = vbYes Then

' e.g. do nothing or end sub

else

    Selection.WholeStory
    Selection.Collapse wdCollapseStart

    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("Heading 1")
    With Selection.Find
        .Text = "Section 1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = True
    End With
    Selection.Find.Execute
    Selection.Collapse wdCollapseStart

    Dim r1 As Range
    Set r1 = Selection.Range

    ' keep format settings, only change text
    Selection.Find.Text = "Section 2"
    If Selection.Find.Execute Then
        Selection.Collapse wdCollapseStart
    Else
        Selection.WholeStory
        Selection.Collapse wdCollapseEnd
    End If
    Dim r2 As Range
    Set r2 = ActiveDocument.Range(r1.Start, Selection.Start)
    r2.Select

但我很难到达终点线 - 现在要根据标题将此范围（或此 selection）移动到文档中的另一个位置（在这种情况下，将此部分插入“第 3 节”和“附件 1”）。

有什么建议吗？

Answer 1

您是对的，但需要避免使用 Selection object。在极少数情况下，使用 Selection 是不可避免的，但这不是其中之一。

Word 有多个隐藏predefined bookmarks，其中一个returns 是一个标题级别的全范围。这在下面的 GetHeadingBlock 函数中使用。

一个Range还有一个FormattedText属性可以用来代替剪贴板

Sub MoveSection()
    Dim moveRange As Range, destRange As Range
    Set moveRange = GetHeadingBlock("Section 1", wdStyleHeading1)
    If Not moveRange Is Nothing Then
        Set destRange = GetHeadingBlock("Section 3", wdStyleHeading1)
        If Not destRange Is Nothing Then
            destRange.Collapse wdCollapseEnd
            destRange.FormattedText = moveRange.FormattedText
            moveRange.Delete
        End If
    End If
End Sub

Public Function GetHeadingBlock(headingText As String, headingStyle As WdBuiltinStyle) As Range
   Dim findRange As Range
   Set findRange = ActiveDocument.Content
   With findRange.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = headingText
      .Style = headingStyle
      .Replacement.Text = ""
      .Forward = True
      .Format = True
      .Wrap = wdFindStop
      If .Execute Then Set GetHeadingBlock = _
         findRange.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
   End With
End Function

使用标题移动文本

Move text using headings

vba

ms-word