Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос по обрезке рисунка. - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос по обрезке рисунка. (Макросы/Sub)
Макрос по обрезке рисунка.
SkyGreen Дата: Суббота, 30.03.2019, 16:43 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 45
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Доброго времени.
Пытаюсь написать макрос по обрезке рисунка.

Вырезаемая область (под которую нужно сделать обрезку ... хотя бы примерно) - определяется точкой, координаты которой находятся в ячейках E8 и F8.

В ячейках E12 и F12 - находятся процентные соотношения длины и ширины (области для вырезания) - по отношению к сторонам рисунка.
То есть допустим - если в ячейке E12 стоит число 0.35 - то это значит что ширина области под вырезку - равна 35% ширины самой целой картинки.

Подскажите как сделать обрезку - зависимой только от этих четырех ячеек (E8 , F8, E12 и F12)

Сейчас этот макрос выглядит вот так (Я в нем если честно не понимаю откуда берутся цифры):
[vba]
Код
Sub Макрос2()

    ActiveSheet.Shapes.Range(Array("Picture 9")).Select
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.IncrementLeft 36.7499212598
    Selection.ShapeRange.ScaleWidth 0.8615819209, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 265
    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 293
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = -18
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 0
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.IncrementLeft 0.00007874015748
    Selection.ShapeRange.ScaleWidth 0.3245905082, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 265
    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 293
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 58
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 0
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.IncrementTop 25.5
    Selection.ShapeRange.ScaleHeight 0.9130434783, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 265
    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 293
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 58
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -12
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.ScaleHeight 0.3053221289, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 265
    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 293
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 58
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 80
    Range("A9").Select
End Sub
[/vba]
К сообщению приложен файл: 86737.xlsm(24.9 Kb)
 
Ответить
СообщениеДоброго времени.
Пытаюсь написать макрос по обрезке рисунка.

Вырезаемая область (под которую нужно сделать обрезку ... хотя бы примерно) - определяется точкой, координаты которой находятся в ячейках E8 и F8.

В ячейках E12 и F12 - находятся процентные соотношения длины и ширины (области для вырезания) - по отношению к сторонам рисунка.
То есть допустим - если в ячейке E12 стоит число 0.35 - то это значит что ширина области под вырезку - равна 35% ширины самой целой картинки.

Подскажите как сделать обрезку - зависимой только от этих четырех ячеек (E8 , F8, E12 и F12)

Сейчас этот макрос выглядит вот так (Я в нем если честно не понимаю откуда берутся цифры):
[vba]
Код
Sub Макрос2()

    ActiveSheet.Shapes.Range(Array("Picture 9")).Select
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.IncrementLeft 36.7499212598
    Selection.ShapeRange.ScaleWidth 0.8615819209, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 265
    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 293
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = -18
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 0
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.IncrementLeft 0.00007874015748
    Selection.ShapeRange.ScaleWidth 0.3245905082, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 265
    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 293
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 58
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 0
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.IncrementTop 25.5
    Selection.ShapeRange.ScaleHeight 0.9130434783, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 265
    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 293
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 58
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -12
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.ScaleHeight 0.3053221289, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 265
    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 293
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 58
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 80
    Range("A9").Select
End Sub
[/vba]

Автор - SkyGreen
Дата добавления - 30.03.2019 в 16:43
bmv98rus Дата: Суббота, 30.03.2019, 20:42 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 2278
Репутация: 399 ±
Замечаний: 20% ±

Excel 2013/2016
Если не требуется масштабировать , то все несколько проще.
[vba]
Код
Sub MyCrop()
With ActiveSheet.Shapes("Овал 7")
    CentrX = .Left + .Width / 2
    CentrY = .Top + .Height / 2
End With

With ActiveSheet.Shapes("Рисунок 9")
    Pleft = .Left
    Ptop = .Top
    PWidth = .Width
    PHeight = .Height
    CropSizeX = PWidth * [e12]
    CropSizeY = PHeight * [F12]
    With .PictureFormat
        .CropLeft = CentrX - CropSizeX / 2 - Pleft
        .CropRight = Pleft + PWidth - CentrX - CropSizeX / 2
        .CropTop = CentrY - CropSizeY / 2 - Ptop
        .CropBottom = Ptop + PHeight - CentrY - CropSizeY / 2
    End With
End With
End SUB
[/vba]


Замечательный медведь, процентов на 20.

Сообщение отредактировал bmv98rus - Суббота, 30.03.2019, 20:53
 
Ответить
СообщениеЕсли не требуется масштабировать , то все несколько проще.
[vba]
Код
Sub MyCrop()
With ActiveSheet.Shapes("Овал 7")
    CentrX = .Left + .Width / 2
    CentrY = .Top + .Height / 2
End With

With ActiveSheet.Shapes("Рисунок 9")
    Pleft = .Left
    Ptop = .Top
    PWidth = .Width
    PHeight = .Height
    CropSizeX = PWidth * [e12]
    CropSizeY = PHeight * [F12]
    With .PictureFormat
        .CropLeft = CentrX - CropSizeX / 2 - Pleft
        .CropRight = Pleft + PWidth - CentrX - CropSizeX / 2
        .CropTop = CentrY - CropSizeY / 2 - Ptop
        .CropBottom = Ptop + PHeight - CentrY - CropSizeY / 2
    End With
End With
End SUB
[/vba]

Автор - bmv98rus
Дата добавления - 30.03.2019 в 20:42
SkyGreen Дата: Суббота, 30.03.2019, 22:34 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 45
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
bmv98rus, спасибо за ответ.
 
Ответить
Сообщениеbmv98rus, спасибо за ответ.

Автор - SkyGreen
Дата добавления - 30.03.2019 в 22:34
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос по обрезке рисунка. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!