|
Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Скриптовые языки администрирования Windows » VBS/WSH/JS - Как определить масштаб изображения в процентах в PowerPoint при помощи VBA |
|
VBS/WSH/JS - Как определить масштаб изображения в процентах в PowerPoint при помощи VBA
|
Новый участник Сообщения: 18 |
Профиль | Отправить PM | Цитировать Здравствуйте.
Хочу решить следующую проблему: При изменении размеров слайдов с 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 |
|
Отправлено: 09:10, 10-02-2019 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать kosmonavtom, для начала хотелось бы понять, как выглядит «изменение размеров слайдов с 4:3 на 16:9»?
|
Отправлено: 10:12, 10-02-2019 | #2 |
Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети. Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля. |
Новый участник Сообщения: 18
|
Профиль | Отправить PM | Цитировать Цитата:
Для наглядности, на всякий случай, сделал две презентации (см. вложения), изначально в размерах 4:3, потом перевел размер экрана (слайдов) в 16:9 рисунок добавленный в размерах 4:3 имел размер (масштаб) 54% на 54% а измененный стал: 41% на 54% вот у презентации 16:9 как то нужно получить вот эти проценты в переменные sHeightOld и sWidthOld. Вопрос: как? |
|
Отправлено: 20:22, 10-02-2019 | #3 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать В общем, что я вижу.
1. В результате произведённого изменения пропорций произошло не «растягивание»: Цитата kosmonavtom:
2. Ваш алгоритм работоспособен только при условии, что изображения, помещённые в презентацию изменялись строго пропорционально. Если же изображение до конвертации с 4:3 в 16:9 уже имело иные пропорции, нежели 1x1, что отнюдь не редкость — то весь алгоритм летит к чёрту. Так что, я бы сделал иначе. Пробуйте: Скрытый текст
Option Explicit Sub ReScaleToHeight() Dim objSlide As Slide Dim objShape As Shape Dim intCurrentWidth As Integer Dim intCurrentHeigth As Integer Dim intOriginalWidth As Integer Dim intOriginalHeigth As Integer Dim sngAspectRatio As Single For Each objSlide In ActivePresentation.Slides For Each objShape In objSlide.Shapes With objShape If .Type = msoPicture Or .Type = msoEmbeddedOLEObject Then intCurrentWidth = .Width intCurrentHeigth = .Height .ScaleHeight CSng(1), msoTrue .ScaleWidth CSng(1), msoTrue intOriginalWidth = .Width intOriginalHeigth = .Height If intCurrentWidth / intOriginalWidth < intCurrentHeigth / intOriginalHeigth Then sngAspectRatio = intCurrentWidth / intOriginalWidth Else sngAspectRatio = intCurrentHeigth / intOriginalHeigth End If .ScaleHeight sngAspectRatio, msoTrue .ScaleWidth sngAspectRatio, msoTrue End If End With Next Next End Sub Если всё же хотите по-своему — поменяйте в условии < на >. |
|
Отправлено: 21:57, 10-02-2019 | #4 |
Новый участник Сообщения: 18
|
Профиль | Отправить PM | Цитировать Доброе утро. Iska, во первых огромное спасибо за Ваш код! Все работает и это главное
Цитата:
Цитата:
Б) Какие пропорции изначально у изображения - не имеет значения, т.к. главное, чтобы оно стало таким-же как и было в презентации 4:3. Еще раз спасибо. |
|||
Отправлено: 08:06, 11-02-2019 | #5 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать Цитата kosmonavtom:
|
|
Отправлено: 20:49, 11-02-2019 | #6 |
Участник сейчас на форуме | Участник вне форума | Автор темы | Сообщение прикреплено |
| |||||
Название темы | Автор | Информация о форуме | Ответов | Последнее сообщение | |
VBA - VBA WORD При наборе текста, автоматическая вставка изображения HELP! | fearnewstyle | Программирование и базы данных | 3 | 13-11-2011 15:27 | |
2010 - [решено] Изменить масштаб документа при печати | rsod | Microsoft Office (Word, Excel, Outlook и т.д.) | 5 | 02-05-2011 21:25 | |
Как узнать точный(в процентах) заряд батарей | 181294 | Мобильные ОС, смартфоны и планшеты | 3 | 06-09-2009 17:26 | |
[решено] Молчит спикер при запуске компьютера. Не определить причину отсутствия изображения. | maik2 | Непонятные проблемы с Железом | 7 | 18-11-2008 22:56 | |
Масштаб при сканировании и печати | Sherla | Хочу все знать | 12 | 25-11-2006 20:52 |
|