Вытягивание нижней границы фигур-прямоугольников

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

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

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вытягивание нижней границы фигур-прямоугольников (Макросы/Sub)

perven

Дата: Четверг, 30.11.2017, 21:34 | Сообщение № 1

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

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

Сообщений: 67

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

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

Excel 2013

Здравствуйте, умудренные опытом седобородые мужи - знатоки ВБА.
Помогите с решением задачи.

На листе есть две фигуры-прямоугольника.
Там же находится еще фигура Треугольник.
Как макросом вытягивать нижнюю границу прямоугольников - до координаты размещения Треугольника по оси Y ?

(То есть если я перемещаю Треугольник вверх и жму на кнопку - то прямоугольники укорачиваются до уровня размещения треугольника.
Если же я опускаю треугольник вниз - то при запуске макроса - прямоугольники уже удлиняются, поскольку координата Y треугольника - стала больше)
(Верхние границы прямоугольников - не меняются)

К сообщению приложен файл: 45368.xls (36.5 Kb)

Ответить

Manyasha

Дата: Четверг, 30.11.2017, 22:07 | Сообщение № 2

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

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

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

Excel 2010, 2016

Цитата perven, 30.11.2017 в 21:34, в сообщении № 1 ()

Здравствуйте, умудренные опытом седобородые мужи - знатоки ВБА

хоть я и не вклиниваюсь в это описание

, рискну предложить такой вариант:
Фигуры на листе переименовала (см. в окошке слева от строки формул)
[vba]

Код

Sub test()
    Dim t As Shape, r1 As Shape, r2 As Shape
    Set t = ActiveSheet.Shapes("triangle")
    Set r1 = ActiveSheet.Shapes("rec1")
    Set r2 = ActiveSheet.Shapes("rec2")
    r1.Height = t.Top - r1.Top
    r2.Height = t.Top - r2.Top
End Sub

[/vba]

Цитата perven, 30.11.2017 в 21:34, в сообщении № 1 ()

Верхние границы прямоугольников - не меняются

даже, если треугольник окажется выше прямоугольника?

К сообщению приложен файл: 45368-1.xls (46.5 Kb)

ЯД: 410013299366744 WM: R193491431804

Ответить

perven

Дата: Четверг, 30.11.2017, 22:15 | Сообщение № 3

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

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

Сообщений: 67

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

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

Excel 2013

Manyasha, большое спасибо - все именно так как нужно.

А про седобородых мужей - это уж я так...

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вытягивание нижней границы фигур-прямоугольников (Макросы/Sub)

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