Определение расстояний между фигурами

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

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

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

Megamen2

Дата: Понедельник, 24.12.2018, 15:58 | Сообщение № 1

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

Ранг: Новичок

Сообщений: 25

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

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

Excel 2007

Приветствую всех форумчан.
Помогите решить вопрос. На листе - ряд фигур и картинка с названием Рисунок 7
Как макросом выписать в ячейки, находящиеся по фигурами - расстояние от их центров - до центра рисунка ?

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

Сообщение отредактировал Megamen2 - Понедельник, 24.12.2018, 20:27

Ответить

bmv98rus

Дата: Вторник, 25.12.2018, 22:04 | Сообщение № 2

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

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

Сообщений: 4106

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

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

Excel 2013/2016

центр равен вехний левый угол + половина ширены (высоты)
Растояние между центрами - корень из суммы квадратов разности координат

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

Ответить

Megamen2

Дата: Среда, 26.12.2018, 00:07 | Сообщение № 3

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

Ранг: Новичок

Сообщений: 25

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

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

Excel 2007

bmv98rus, вы не могли бы привести пример хотя бы для одной пары фигур "Рисунок 7" / "Прямоугольник 5" ?

Ответить

bmv98rus

Дата: Среда, 26.12.2018, 09:46 | Сообщение № 4

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

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

Сообщений: 4106

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

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

Excel 2013/2016

[vba]

Код

Function DistanceCent(objA As Object, objB As Object)
DistanceCent = Sqr((objA.Left + objA.Width / 2 - objB.Left + objB.Width / 2) ^ 2 + (objA.Top + objA.Height / 2 - objB.Top + objB.Height / 2) ^ 2)
End Function

Sub test()
Dim objShape As Object
For Each objShape In Sheet3.Shapes
If objShape.Name Like "Прямоугольник*" Then
Debug.Print DistanceCent(Sheet3.Shapes("Рисунок 7"), objShape)
End If
Next

[/vba]

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

Ответить

Megamen2

Дата: Среда, 26.12.2018, 12:10 | Сообщение № 5

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

Ранг: Новичок

Сообщений: 25

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

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

Excel 2007

bmv98rus, что-то пока не срабатывает.
При запуске оказывает ошибку "Run-time error '424': Object required"

И подсвечивает строку:
[vba]

Код

For Each objShape In Sheet3.Shapes

[/vba]

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

Сообщение отредактировал Megamen2 - Среда, 26.12.2018, 12:10

Ответить

bmv98rus

Дата: Среда, 26.12.2018, 12:38 | Сообщение № 6

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

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

Сообщений: 4106

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

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

Excel 2013/2016

поменяйте Sheet3 на тот что у Вас или на ActiveSheet.

сразу скажу, выводить в нужные ячейки я не стал.

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

Ответить

Megamen2

Дата: Среда, 26.12.2018, 12:45 | Сообщение № 7

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

Ранг: Новичок

Сообщений: 25

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

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

Excel 2007

bmv98rus, я поменял название листа.
Теперь выглядит так.
[vba]

Код

Function DistanceCent(objA As Object, objB As Object)
DistanceCent = Sqr((objA.Left + objA.Width / 2 - objB.Left + objB.Width / 2) ^ 2 + (objA.Top + objA.Height / 2 - objB.Top + objB.Height / 2) ^ 2)
End Function

Sub test()
Dim objShape As Object
For Each objShape In Sheets("Лист3").Shapes
If objShape.Name Like "Прямоугольник*" Then
Debug.Print DistanceCent(Sheets("Лист3").Shapes("Рисунок 7"), objShape)
End If
Next

End Sub

[/vba]
А как вывести в ячейку D7 результат, чтобы просто посмотреть на него ?
Ставлю вот такую строчку - что-то не работает:
[vba]

Код

Range("D7") = DistanceCent(Sheets("Лист3").Shapes("Рисунок 7"), objShape)

[/vba]

Просто я сейчас не могу посмотреть на результат, поскольку макрос его нигде не показывает.