Код VBA для настройки размера изображения в PowerPoint 2016

0 PSR [2018-06-13 22:05:00]

Я нахожусь на своей первой неделе обучения VBA, и я ищу код VBA, который поможет мне изменить размер и переместить изображения, вставленные в PowerPoint 2016. Ниже приведены требуемые данные формата изображения:

Размер - Высота = 3.39 "- Ширина = 6.67" - Вращение = 0 - Высота шкалы = 62% - Ширина шкалы = 62% - Соотношение сторон = Заблокировано - Относительно исходного размера изображения = true

Положение - Горизонтальное положение = 0 - Верхний левый угол - Вертикальное положение = 2.06 - Верхний левый угол

Любая помощь будет принята с благодарностью.

vba image-resizing

Оригинал вопроса (на английском)

5 ответов

1 PSR [2018-06-24 23:08:00]

Ниже центрирует изображение в слайде

Sub ResizeAll()
For Each tSlide In ActiveWindow.Presentation.Slides
    tSlide.Select
    With tSlide.Shapes.Item(1)
    'assume a blank slide with one image added only
        .Select
        .Height = 72 * 3.39
        .Width = 72 * 6.67
    'algin middle (Horizontal Center)
        .Left = ActivePresentation.PageSetup.SlideWidth / 2 - .Width / 2
        .Top = ActivePresentation.PageSetup.SlideHeight / 2 - .Height / 2
    End With
Next
End Sub

Оригинал ответа (на английском)

0 Marcucciboy2 [2018-06-13 22:52:00]

Хорошо, так что этот макрос отрегулирует детали каждого изображения в вашей PowerPoint.

Sub AdjustImages()

    Dim curSlide As Slide
    Dim curShape As Shape

    For Each curSlide In ActivePresentation.Slides
        For Each curShape In curSlide.Shapes
            With curShape

                'size:
                ''1 inch = 72 points
                .Height = 72 * 3.39
                .Width = 72 * 6.67

                .ScaleHeight 0.62, msoTrue
                .ScaleWidth 0.62, msoTrue

                .LockAspectRatio = msoTrue


                'position:
                .Rotation = 0

                .Left = 0
                .Top = 2.06

                'Relative to original picture size = true

            End With
        Next curShape
    Next curSlide

End Sub

Единственная часть вашего вопроса, которую я действительно не понимаю, - это когда вы упоминаете, что это "относительно исходного размера изображения = истина". Кажется, я не могу найти атрибут, который соответствует этому.

Оригинал ответа (на английском)

0 PSR [2018-06-13 23:52:00]

"Относительно исходного размера изображения" находится флажок, расположенный под форматом. Вероятно, я указал неверный оператор. Это; однако, проверяется, когда я просматриваю размер и положение изображения. Не уверен, требуется ли утверждение.

Я добавил и запустил код. Произошла следующая ошибка:

Ошибка времени выполнения -2147024809 (80070057) Аргумент RelativetoOriginalSie применяется только к изображению или объекту OLE.

При отладке кода выделялось следующее:

.ScaleHeight 0.62, msoTrue

Оригинал ответа (на английском)

0 PSR [2018-06-24 23:11:00]

Ниже центрирует изображение и выравнивает его влево

Sub ResizeAll()
For Each tSlide In ActiveWindow.Presentation.Slides
    tSlide.Select
    With tSlide.Shapes.Item(1)
    'assume a blank slide with one image added only
        .Select
        .Height = 72 * 3.39
        .Width = 72 * 6.67
    'algin middle (Horizontal Center)
        .Left = 0
        .Top = ActivePresentation.PageSetup.SlideHeight / 2 - .Height / 2
    End With
Next
End Sub

Оригинал ответа (на английском)

0 PSR [2018-06-24 23:00:00]

Ниже приведен код, который работал для меня. Спасибо за поддержку.

Sub ResizeAll()
For Each tSlide In ActiveWindow.Presentation.Slides
    tSlide.Select
    With tSlide.Shapes.Item(1)
    'assume a blank slide with one image added only
        .Select
        .Height = 72 * 3.39
        .Width = 72 * 6.67
    'algin middle (Horizontal Center)
        .Left = 0
        .Top = ActivePresentation.PageSetup.SlideHeight / 3.25
    End With
Next
End Sub

Оригинал ответа (на английском)