Изменение размера фигуры между субтитрами и нижним колонтитулом в слайде Powerpoint - PullRequest
0 голосов
/ 17 апреля 2020

Есть ли способ изменить размеры фигур (рисунков, таблиц, диаграмм), вставленных из рабочей таблицы Excel в слайды Powerpoint, чтобы каждая фигура изменялась относительно своих исходных размеров (LockAspectRatio = True) и помещалась точно между подзаголовком слайда и Нижний колонтитул и по центру по горизонтали?

Фигуры могут иметь различные размеры, то есть иногда очень маленькие или иногда больше, чем размеры слайда. Поэтому критерий состоит в том, чтобы изменить их размер (без искажений), чтобы они подходили между субтитрами и нижним колонтитулом и были выровнены по горизонтали.

Возможно ли это с помощью Excel VBA?

Редактировать: ниже logi c работает неправильно.

Sub ResizeShapesInSlide()

Dim L#, T#, W#, H#, SlideCnt%, i%
Dim sHeight#, sWidth#
Dim oSlide As Slide, oShp As Shape

SlideCnt = ActivePresentation.Slides.Count

For i = 1 To SlideCnt
    Set oSlide = ActivePresentation.Slides(i)
    With oSlide
        .Select

        ' get Slide height & width
        sHeight = ActivePresentation.PageSetup.SlideHeight
        sWidth = ActivePresentation.PageSetup.SlideWidth

        Set oShp = .Shapes("Picture 1")
        With oShp
            .Select
            .LockAspectRatio = msoTrue

            ' resize if image larger than Slide dimensions
            If .Width >= sWidth Then .Width = sWidth - oSlide.Shapes("SubTitle").Left
            If .Height >= sHeight Then .Height = sHeight - oSlide.Shapes("Footer").Top

'            L = .Left: T = .Top: W = .Width: H = .Height

            ' Set shape Top to SubTitle Top + Height
            .Top = (oSlide.Shapes("SubTitle").Top + oSlide.Shapes("SubTitle").Height) + 5

            ' Initially set Shape to SubTitle Left
            .Left = oSlide.Shapes("SubTitle").Left

             ' now adjust Shape height till Footer Top
            .Height = .Height - (sHeight - oSlide.Shapes("Footer").Top - 5)

            ' finally center shape horizontally
            .Left = (sWidth - .Width) / 2
        End With
    End With
Next i
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...