Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  | Правила  

Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Скриптовые языки администрирования Windows » VBS/WSH/JS - Как определить масштаб изображения в процентах в PowerPoint при помощи VBA

Ответить
Настройки темы
VBS/WSH/JS - Как определить масштаб изображения в процентах в PowerPoint при помощи VBA

Новый участник


Сообщения: 16
Благодарности: 1

Профиль | Отправить 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
Но он конечно НЕ работает полноценно, т.к. никак не могу найти решение задачи из второго шага своего алгоритма (узнать процент высоты и процент ширины изображения). Может у кого-то из Вас есть решение проблемы? Или подсказка где найти ответ на вопрос про процент изображения из PowerPoint? Это вообще возможно? Заранее спасибо за ответ.

Отправлено: 09:10, 10-02-2019

 

Ветеран


Contributor


Сообщения: 24016
Благодарности: 6975

Профиль | Отправить PM | Цитировать


kosmonavtom, для начала хотелось бы понять, как выглядит «изменение размеров слайдов с 4:3 на 16:9»?
Это сообщение посчитали полезным следующие участники:

Отправлено: 10:12, 10-02-2019 | #2



Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети.

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


Новый участник


Сообщения: 16
Благодарности: 1

Профиль | Отправить PM | Цитировать


Вложения
Тип файла: zip две презентации.zip
(85.1 Kb, 1 просмотров)

Цитата:
как выглядит «изменение размеров слайдов с 4:3 на 16:9»?
В PowerPoint 2007 команда: Дизайн - Параметры страницы - Размер экрана.

Для наглядности, на всякий случай, сделал две презентации (см. вложения), изначально в размерах 4:3, потом перевел размер экрана (слайдов) в 16:9 рисунок добавленный в размерах 4:3 имел размер (масштаб) 54% на 54% а измененный стал: 41% на 54% вот у презентации 16:9 как то нужно получить вот эти проценты в переменные sHeightOld и sWidthOld. Вопрос: как?

Отправлено: 20:22, 10-02-2019 | #3


Ветеран


Contributor


Сообщения: 24016
Благодарности: 6975

Профиль | Отправить PM | Цитировать


В общем, что я вижу.

1. В результате произведённого изменения пропорций произошло не «растягивание»:
Цитата kosmonavtom:
При изменении размеров слайдов с 4:3, на 16:9 в PowerPoint 2007 изображения растягиваются причем только по ширине слайдов презентации. »
изображений, а сжатие по высоте. Поэтому «растягивание» приведёт только к тому, что рисунки и объекты «уползут» за размеры слайда.

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


Новый участник


Сообщения: 16
Благодарности: 1

Профиль | Отправить PM | Цитировать


Доброе утро. Iska, во первых огромное спасибо за Ваш код! Все работает и это главное

Цитата:
1. В результате произведённого изменения пропорций произошло не «растягивание» изображений, а сжатие по высоте. Поэтому «растягивание» приведёт только к тому, что рисунки и объекты «уползут» за размеры слайда.
Да это я перепутал и увидел уже после отправки сообщения, но это меня и не волновало сильно.


Цитата:
2. Ваш алгоритм работоспособен только при условии, что изображения, помещённые в презентацию изменялись строго пропорционально. Если же изображение до конвертации с 4:3 в 16:9 уже имело иные пропорции, нежели 1x1, что отнюдь не редкость — то весь алгоритм летит к чёрту.
А) Алгоритм то может и работоспособен, но код нет. (( И можно ли взять и записать процент изображения в переменную я так и не понял. Но мне теперь уже это и не интересно - раз его можно найти другим способом.
Б) Какие пропорции изначально у изображения - не имеет значения, т.к. главное, чтобы оно стало таким-же как и было в презентации 4:3.

Еще раз спасибо.

Отправлено: 08:06, 11-02-2019 | #5


Ветеран


Contributor


Сообщения: 24016
Благодарности: 6975

Профиль | Отправить PM | Цитировать


Цитата kosmonavtom:
И можно ли взять и записать процент изображения в переменную я так и не понял. »
kosmonavtom, нет-нкт, Вы всё правильно поняли — напрямую это значение недоступно (во всяком случае, в моей версии Microsoft Office). Посему, чтобы посчитать его, нужно запомнить текущие размеры, затем сбросить их в оригинальные, затем разделить одно на другое. Что-то подобное приходилось проделывать в первых версиях Automation под Adobe Photoshop, где не было возможности узнать размер существующего выделения (вот не было — и всё тут!), посему приходилось изворачиваться — делать Crop, затем получать размеры получившегося после обрезки изображения, принимать их за размер выделения, после чего исполнять операцию Undo. Вот такие извращения когда-то были в объектной модели Adobe Photoshop .

Отправлено: 20:49, 11-02-2019 | #6



Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Скриптовые языки администрирования Windows » VBS/WSH/JS - Как определить масштаб изображения в процентах в PowerPoint при помощи VBA

Участник сейчас на форуме Участник сейчас на форуме Участник вне форума Участник вне форума Автор темы Автор темы Шапка темы Сообщение прикреплено

Похожие темы
Название темы Автор Информация о форуме Ответов Последнее сообщение
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




 
Переход