无需复制/粘贴即可移动图像

Question

现在我有一个Word宏，通过将图像复制并粘贴到该位置，在特定文本前移动图像。这很好用，但成本很高。如果我的Word文档中有1,000个图像，则运行宏可能需要30分钟。

必须有更好的方法吗？

我可以在不复制/粘贴整个图像的情况下移动图像锚吗？

我的最终目标是采用文本+在表格中对齐的图像（文本左侧，图像右侧），将其从表格中分离出来，但保持左/右性质。

具体来说，我正在寻找表格中的图像（第1行第2列），并希望将它们移动到同一个表格中的文本的开头（第1列，第1行）。这是一个片段：

For Each shape In innerTable.Cell(1, 2).Range.InlineShapes
    If shape.Type = wdInlineShapePicture Then
        shape.Select
        Selection.Cut
        innerTable.Range.Paragraphs(1).Range.Characters(1).Paste
        'Do it only for the 1st image found:
        Exit For
    End If

Next

注意，为了简单起见，我省略了一些安全检查（假设我已经找到了一个有效大小的表，等等。

Answer 1

如果目标位于同一页面，则只能移动Shape。在这种情况下，可以通过更改其Top和Left属性来移动Shape。不幸的是（非常），没有办法通过改变锚点来移动图像。因此，将图像移动到另一个页面（或故事）的唯一方法是使用复制/粘贴。

如果要移动InlineShape，只需将InlineShape.Range.FormattedText指定给目标Range。或者，使用文本扩展范围以包含InlineShape。就Word而言，InlineShape是一个角色。

达到规定的最终目标

取文本+在表格中对齐的图像（文本左侧，图像右侧），将其从表格中分离出来，但保持左/右性质

在右侧使用带有附加列的表。将图像作为InlineShape放入其中。然后可以处理整行，例如如下。

这将在所需位置创建一个新行，复制要移动到新行的行的Range.FormattedText。删除此创建的其他行，并删除原始行。

Sub MoveRow()
    Dim tbl As Word.Table
    Dim rwToMove As Word.Row
    Dim rwTarget As Word.Row
    Dim rwBeforeTarget As Word.Row
    Dim posNewRow As Long

    posNewRow = 1
    Set rwToMove = Selection.Rows(1)
    Set tbl = rwToMove.Range.Tables(1)
    Set rwBeforeTarget = tbl.Rows(posNewRow)
    Set rwTarget = tbl.Range.Rows.Add(rwBeforeTarget) '(posNewRow)
    rwTarget.Range.FormattedText = rwToMove.Range.FormattedText
    tbl.Rows(posNewRow + 1).Delete
    rwToMove.Delete
End Sub