Макрос Word VBA, который перемещает все якоря в верхнюю часть плавающего изображения

Question

У меня есть несколько больших документов с +50 изображений каждый.Проблема в том, что большинство из них являются плавающими изображениями.Положение хорошее, но изображения привязаны в неправильных местах (чаще всего до последней строки на странице).Я хочу переместить все якоря в положение, где их изображение плавает.

(Более точное описание, из комментариев: я хочу прочитать положение изображения и переместить его привязку в это место. Поэтому, если изображение находится в середине страницы 3, а его привязка находится внизу страницы3, я хочу переместить якорь в середину этой страницы. И сделать то же самое для всех изображений.)

Возможно ли это?

Я не могу сделать их встроенными, это изменит структуру моих документов.Я пытался переместить их на какое-то значение, но макрос не меняет положение якоря.

Answer 1

Попробуйте:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, vPos As Single, Rng As Range
With ActiveDocument
  For i = .Shapes.Count To 1 Step -1
    With .Shapes(i)
      .RelativeVerticalPosition = wdRelativeVerticalPositionPage: vPos = .Top
      With .Anchor
        If .Information(wdVerticalPositionRelativeToPage) > vPos Then
          Set Rng = .Paragraphs.First.Range
          Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
          With Rng
            Do While .Paragraphs(1).Range.Characters.Last.Information(wdVerticalPositionRelativeToPage) < vPos
              .Start = .Paragraphs(1).Range.End
            Loop
            .Collapse wdCollapseStart
          End With
          Rng.FormattedText = .FormattedText
          .Delete
        End If
      End With
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub