1

Тема: Сохранение размера изображения

Здравствуйте.
предыстория: работаю на отчетности для более 100 клиентов компании. Каждый месяц составляется аналитика по сайтам компаний из Яндекс метрики. каждый раз после создания скрина, его копирования и вставки в Word мне приходится снова подгонять его размер.

проблема:  Есть ли возможность, чтобы после вставки нового изображения на месте старого сохранялся размер предыдущего?

Схема такая: есть скрин с динамикой посещаемости, когда я сделал сркин и скопировал его, я кликаю по изображению в документе, затем ctrl + v и вставляю новое изображение. И при этом сохраняется размер предыдущего, такое возможно?

2

Re: Сохранение размера изображения

Теоретически такое возможно. Алгоритм макроса такой:

1) Считываются размеры текущей картинки (например, ширина).
2) Текущая картинка удаляется.
3) Производится вставка новой картинки.
4) Изменяется масштаб новой картинки в соответствии с соотношением ширины новой и старой картинки.

Вот пример (из Интернета) макроса, изменяющего размеры картинки:

Sub ScalePic()
Dim inshp As InlineShape
    For Each inshp In ActiveDocument.InlineShapes
        Select Case inshp.Type
            Case 3, 4, 12, 13
            If inshp.ScaleWidth <> 100 Then
                inshp.ScaleWidth = 100
            End If
            If inshp.ScaleHeight <> 100 Then
                inshp.ScaleHeight = 100
            End If
        End Select
    Next inshp
End Sub

Еще несколько примеров:
Уменьшение картинок на 70% от обычного размера:

Sub ScalePic_70()
Dim inshp As InlineShape
    For Each inshp In ActiveDocument.InlineShapes
        Select Case inshp.Type
            Case 3, 4, 12, 13
                inshp.Select
                    inshp.ScaleWidth = 70
                    inshp.ScaleHeight = 70
                End Select
    Next inshp
End Sub

Каждый выделенный рисунок изменяется до 5 см. в ширину:

Sub ResizeImage()
'
' ResizeImage Macro
' Selected image(s) are resized to 5 cm in width
'
    Dim shape As InlineShape
    ' iterate all selected shapes
    For Each shape In Selection.InlineShapes
        ' remain aspect ratio
        shape.LockAspectRatio = msoTrue
        ' set with to 5 cm
        shape.Width = CentimetersToPoints(5)
    Next
End Sub
Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.