kosmonavtom
10-02-2019, 09:10
Здравствуйте.
Хочу решить следующую проблему:
При изменении размеров слайдов с 4:3, на 16:9 в PowerPoint 2007 изображения растягиваются причем только по ширине слайдов презентации.
Задача:
Вернуть размер изображениям в новом размере слайдов (16:9) к исходному относительно процентного соотношения масштаба этого изображения. Делать это вручную бывает долго, т.к. изображений в презентациях бывает тоже очень много, а масштабы у них разные. Поэтому конечно-же нужно решать задачу кодом, я выбрал VBA.
Предлагаю алгоритм:
1) Перебирать все изображения по очереди.
2) Взяв очередное изображение, узнать у него процент высоты и процент ширины (у всех изображений они разные).
3) Если процент ширины больше процента высоты, то присвоить проценту ширины, процент высоты (сравнять их по меньшему)
Нашел на форумах несколько вариантов кодов (перебор, изменение размеров и т.д.) и получил код:
Sub РазмерИзображений()
Dim sld As Slide
Dim img As Shape
Dim sHeightOld As Variant
Dim sWidthOld As Variant
For Each sld In ActivePresentation.Slides
For Each img In sld.Shapes
With img
If .Type = msoLinkedPicture _
Or .Type = msoPicture Then
'ШАГ 2. попытка получить данные, но следующая строка не работает (Compile error: Method or data member not found):
sHeightOld = img.Heigh.Factor
'ШАГ 2. другая попытка получить данные, но Следующая строка не работает (Compile error: Argument not optional):
sWidthOld = img.ScaleWidth.Factor
'Поэтому условие значит тоже не работает (переменных то получить не могу)
If sHeightOld > sWidthOld Then
.LockAspectRatio = msoFalse 'свойство пропорции рисунка = Ложно
'Следующая строка работает, но она ненужна в моем алгоритме:
'.ScaleHeight Factor:=(0.6), RelativeToOriginalSize:=msoCTrue
'Следующая строка которая меняет размер, но она получается тоже работать не может
.ScaleWidth Factor:=(sHeightOld), RelativeToOriginalSize:=msoCTrue
.LockAspectRatio = msoTrue 'свойство пропорции рисунка = Истино
End If
End If
End With
Next
Next sld
End Sub
Но он конечно НЕ работает полноценно, т.к. никак не могу найти решение задачи из второго шага своего алгоритма (узнать процент высоты и процент ширины изображения). Может у кого-то из Вас есть решение проблемы? Или подсказка где найти ответ на вопрос про процент изображения из PowerPoint? Это вообще возможно? Заранее спасибо за ответ.
Хочу решить следующую проблему:
При изменении размеров слайдов с 4:3, на 16:9 в PowerPoint 2007 изображения растягиваются причем только по ширине слайдов презентации.
Задача:
Вернуть размер изображениям в новом размере слайдов (16:9) к исходному относительно процентного соотношения масштаба этого изображения. Делать это вручную бывает долго, т.к. изображений в презентациях бывает тоже очень много, а масштабы у них разные. Поэтому конечно-же нужно решать задачу кодом, я выбрал VBA.
Предлагаю алгоритм:
1) Перебирать все изображения по очереди.
2) Взяв очередное изображение, узнать у него процент высоты и процент ширины (у всех изображений они разные).
3) Если процент ширины больше процента высоты, то присвоить проценту ширины, процент высоты (сравнять их по меньшему)
Нашел на форумах несколько вариантов кодов (перебор, изменение размеров и т.д.) и получил код:
Sub РазмерИзображений()
Dim sld As Slide
Dim img As Shape
Dim sHeightOld As Variant
Dim sWidthOld As Variant
For Each sld In ActivePresentation.Slides
For Each img In sld.Shapes
With img
If .Type = msoLinkedPicture _
Or .Type = msoPicture Then
'ШАГ 2. попытка получить данные, но следующая строка не работает (Compile error: Method or data member not found):
sHeightOld = img.Heigh.Factor
'ШАГ 2. другая попытка получить данные, но Следующая строка не работает (Compile error: Argument not optional):
sWidthOld = img.ScaleWidth.Factor
'Поэтому условие значит тоже не работает (переменных то получить не могу)
If sHeightOld > sWidthOld Then
.LockAspectRatio = msoFalse 'свойство пропорции рисунка = Ложно
'Следующая строка работает, но она ненужна в моем алгоритме:
'.ScaleHeight Factor:=(0.6), RelativeToOriginalSize:=msoCTrue
'Следующая строка которая меняет размер, но она получается тоже работать не может
.ScaleWidth Factor:=(sHeightOld), RelativeToOriginalSize:=msoCTrue
.LockAspectRatio = msoTrue 'свойство пропорции рисунка = Истино
End If
End If
End With
Next
Next sld
End Sub
Но он конечно НЕ работает полноценно, т.к. никак не могу найти решение задачи из второго шага своего алгоритма (узнать процент высоты и процент ширины изображения). Может у кого-то из Вас есть решение проблемы? Или подсказка где найти ответ на вопрос про процент изображения из PowerPoint? Это вообще возможно? Заранее спасибо за ответ.