使用标题移动文本答案

【问题标题】：Move text using headings使用标题移动文本
【发布时间】：2022-08-07 15:24:34
【问题描述】：

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

例如，假设我的文档是这样组织的：

第 1 节
第 2 节
第 3 节
附件一

将 \"Section 1\"、\"Section 2\"、\"Section 3\" 和 \"Annex\" 定义为标题 1 样式。

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

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

a) 什么都不做

b) 执行以下操作：

选择整个“第 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 方法的帖子。

我达到了一个阶段，我使用以下代码找到并选择我感兴趣的部分；

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

我现在很难根据标题将这个范围（或这个选择）移动到文档中的另一个位置（在这种情况下，将这个部分插入到 \"Section 3\" 和 \"Annex 1\" 之间）。

标签： vba ms-word

【解决方案1】：

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

Word 有许多隐藏的predefined bookmarks，其中一个返回标题级别的完整范围。这在下面的 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

【讨论】：

惊人！谢谢。还有一个我没有想到的额外并发症；第 1 部分包含一个书签（我们称之为“Test_move”），我需要将其与该部分的其余部分一起移动。在上面的实现中，这个书签会丢失（原因很明显，在 moveRange.Delete 步骤）。有没有办法在上述方法中移动书签，或者这是没有希望的，我应该考虑一个在移动完成后重新创建书签的子例程？
如果可以轻松识别书签的位置，我会重新创建它。如果没有，您需要剪切并粘贴范围。