Форум по VBA и MS Office

Sub вставка()

    Dim inshape As InlineShape
    Dim высота As Single, пропорция As Double
   
   
    ' Запись в переменную нужной высоты в мм.
    высота = 100
   
    ' Вставка содержимого буфера обмена в выделенный фрагмент или в место курсора.
    Selection.Paste
   
    For Each inshape In Selection.InlineShapes
        пропорция = inshape.Height / inshape.Width
        inshape.Width = MillimetersToPoints(высота / пропорция)
        inshape.Height = MillimetersToPoints(высота)
    Next inshape
   
End Sub

Sub вставка()

    Dim rng As Range, inshape As InlineShape
    Dim высота As Single
   
   
    '1. Запись в переменную нужной высоты в мм.
    высота = 100
   
    '2. Удаление рисунка, если выделен рисунок.
    If Selection.Type = wdSelectionInlineShape Then
        Selection.Delete
    End If
   
    '3. Вставка содержимого буфера обмена в выделенный фрагмент или в место курсора.
    Selection.Paste
   
    '4. Создаём ссылку на мигающий курсор.
    Set rng = Selection.Range.Duplicate
   
    '5. Включаем в ссылку символ, который находится слева от мигающего курсора.
    rng.MoveStart Unit:=wdCharacter, Count:=-1
   
    '6. Присваиваем рисунку имя "inshape" и далее можно обращаться в коде к рисунку по этому имени.
    Set inshape = rng.InlineShapes(1)
   
    '7. Настройки рисунка.
    '1) Ставим галочку "сохранить пропорции", чтобы при изменении высоты, ширина изменялась пропорционально.
    inshape.LockAspectRatio = True
    '2) Изменение высоты.
    inshape.Height = MillimetersToPoints(высота)
   
End Sub