Есть ли способ изменить размеры фигур (рисунков, таблиц, диаграмм), вставленных из рабочей таблицы 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