Макрос по обрезке рисунка.

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос по обрезке рисунка. (Макросы/Sub)

SkyGreen

Дата: Суббота, 30.03.2019, 16:43 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 83

Репутация: 0 ±

Замечаний: 20% ±

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]

Код

[/vba]SkyGreen

К сообщению приложен файл: 86737.xlsm (24.9 Kb)

Ответить

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

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

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

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

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

Код

[/vba]

Автор - SkyGreen
Дата добавления - 30.03.2019 в 16:43

bmv98rus

Дата: Суббота, 30.03.2019, 20:42 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4110

Репутация: 768 ±

Замечаний: 0% ±

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

Ответить

SkyGreen

Дата: Суббота, 30.03.2019, 22:34 | Сообщение № 3

Группа: Пользователи

Ранг: Участник

Сообщений: 83

Репутация: 0 ±

Замечаний: 20% ±

Excel 2016

bmv98rus, спасибо за ответ.

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос по обрезке рисунка. (Макросы/Sub)

Страница 1 из 1
1