不带 copy/paste 移动图像

Question

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

一定有更好的方法吧？

我可以在没有 copy/pasting 整个图像的情况下移动图像锚点吗？

我的最终目标是将文本 + 图像对齐 table（文本左，图像右），将其从 table 中分离出来，但保持 [=25] =]自然.

具体来说，我正在寻找 table 中的图像（第 1 列第 2 列），并希望将它们移动到同一 table 中的文本开头（第 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

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

Answer 1

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

如果要移动InlineShape，只需将InlineShape.Range.FormattedText分配给目标Range即可。或者，用文本扩展范围以也包括 InlineShape。对于Word来说，一个InlineShape就是一个字符。

实现既定的最终目标

take text + an image that is aligned in a table (text left, image right), break it out of the table, but maintain that left/right nature

在右侧使用带有附加列的 table。将图像作为 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

不带 copy/paste 移动图像

Move image without copy/paste

clipboard

vba

ms-word