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

Вход

Регистрация

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

 

= Мир MS Excel/Определение расстояний между фигурами - Мир MS Excel

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

Excel 2007
Приветствую всех форумчан.
Помогите решить вопрос. На листе - ряд фигур и картинка с названием Рисунок 7
Как макросом выписать в ячейки, находящиеся по фигурами - расстояние от их центров - до центра рисунка ?
К сообщению приложен файл: 9007976.xls(52.5 Kb)


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

Автор - Megamen2
Дата добавления - 24.12.2018 в 15:58
bmv98rus Дата: Вторник, 25.12.2018, 22:04 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 1468
Репутация: 243 ±
Замечаний: 0% ±

Excel 2013/2016
центр равен вехний левый угол + половина ширены (высоты)
Растояние между центрами - корень из суммы квадратов разности координат
 
Ответить
Сообщениецентр равен вехний левый угол + половина ширены (высоты)
Растояние между центрами - корень из суммы квадратов разности координат

Автор - bmv98rus
Дата добавления - 25.12.2018 в 22:04
Megamen2 Дата: Среда, 26.12.2018, 00:07 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 0 ±
Замечаний: 0% ±

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

Автор - Megamen2
Дата добавления - 26.12.2018 в 00:07
bmv98rus Дата: Среда, 26.12.2018, 09:46 | Сообщение № 4
Группа: Проверенные
Ранг: Старожил
Сообщений: 1468
Репутация: 243 ±
Замечаний: 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]
 
Ответить
Сообщение[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]

Автор - bmv98rus
Дата добавления - 26.12.2018 в 09:46
Megamen2 Дата: Среда, 26.12.2018, 12:10 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 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, что-то пока не срабатывает.
При запуске оказывает ошибку "Run-time error '424': Object required"

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

For Each objShape In Sheet3.Shapes
[/vba]

Автор - Megamen2
Дата добавления - 26.12.2018 в 12:10
bmv98rus Дата: Среда, 26.12.2018, 12:38 | Сообщение № 6
Группа: Проверенные
Ранг: Старожил
Сообщений: 1468
Репутация: 243 ±
Замечаний: 0% ±

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

сразу скажу, выводить в нужные ячейки я не стал.
 
Ответить
Сообщениепоменяйте Sheet3 на тот что у Вас или на ActiveSheet.

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

Автор - bmv98rus
Дата добавления - 26.12.2018 в 12:38
Megamen2 Дата: Среда, 26.12.2018, 12:45 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 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]

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


Сообщение отредактировал Megamen2 - Среда, 26.12.2018, 12:47
 
Ответить
Сообщение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]

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

Автор - Megamen2
Дата добавления - 26.12.2018 в 12:45
bmv98rus Дата: Среда, 26.12.2018, 13:24 | Сообщение № 8
Группа: Проверенные
Ранг: Старожил
Сообщений: 1468
Репутация: 243 ±
Замечаний: 0% ±

Excel 2013/2016
Debug.Print - показывает результат в окне отладки.
 
Ответить
СообщениеDebug.Print - показывает результат в окне отладки.

Автор - bmv98rus
Дата добавления - 26.12.2018 в 13:24
Megamen2 Дата: Среда, 26.12.2018, 13:43 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
bmv98rus, я открываю окно отладки, запускаю макрос "test".
И ничего не происходит.
Окно отладки - пустое, в нем ничего не появляется.
 
Ответить
Сообщениеbmv98rus, я открываю окно отладки, запускаю макрос "test".
И ничего не происходит.
Окно отладки - пустое, в нем ничего не появляется.

Автор - Megamen2
Дата добавления - 26.12.2018 в 13:43
Megamen2 Дата: Среда, 26.12.2018, 16:05 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 0 ±
Замечаний: 0% ±

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

Автор - Megamen2
Дата добавления - 26.12.2018 в 16:05
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Определение расстояний между фигурами (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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