Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
28.03.2024, 19:13:04

Войти
На форуме добавлена возможность подписки на RSS-ленты любого раздела форума. Подписаться можно, нажав на иконку RSS , расположенную левее наименования раздела.
33 233 Сообщений в 5 454 Тем от 6 750 Пользователей
Последний пользователь: Alex1210
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
+  Excel это не сложно
|-+  Основные форумы
| |-+  Вопросы по Excel и VBA
| | |-+  Замена в макросе - луча на отрезок.
Страниц: [1]   Вниз
Печать
Автор Тема: Замена в макросе - луча на отрезок.  (Прочитано 1601 раз)
0 Пользователей и 1 Гость смотрят эту тему.
radioamator2
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 1


Просмотр профиля
« : 26.01.2019, 01:39:39 »

Здравствуйте.
Столкнулся с проблемой.

Макрос записывает в столбец P5:P20 - названия фигур, которые пересекает луч (бесконечная линия).
Луч задается отрезком по двум координатам, заданным в L4:M5.

Посоветуйте, если кто разбирается в этом - как выносить в столбец P5:P20 - те фигуры, которые пересекает не луч (бесконечная линия), а только отрезок ?

Код: (vb)

Option Explicit
  Private shp As Shape, sh As Shape, s$, k#, a#, x#, y#, ok As Boolean, x1#, x2#, y1#, y2#
 
 
Sub Линия1()
  'Dim shp As Shape, sh As Shape, s$, k#, a#, x#, y#, ok As Boolean, x1#, x2#, y1#, y2#
  s = Empty
  Range("P5:P33").ClearContents
Dim i&
 
  x1 = Range("L4"): y1 = Range("M4")
  x2 = Range("L5"): y2 = Range("M5")
  k = (y2 - y1) / (x2 - x1):  a = y1 - k * x1
  Set shp = ActiveSheet.Shapes.AddLine(x1, y1, x2, y2)
  shp.Line.EndArrowheadStyle = msoArrowheadTriangle
  shp.Line.Weight = 2
  shp.Line.ForeColor.RGB = RGB(255, 0, 0)
  For Each sh In ActiveSheet.Shapes
    If sh.Name <> shp.Name Then
      x = sh.Left:  y = k * x + a:  ok = IsBetween(y, sh.Top, sh.Top + sh.Height)
      If Not ok Then x = sh.Left + sh.Width: y = k * x + a: ok = IsBetween(y, sh.Top, sh.Top + sh.Height)
      If Not ok Then y = sh.Top:  x = (a - y) / k: ok = IsBetween(x, sh.Left, sh.Left + sh.Width)
      If Not ok Then y = sh.Top + sh.Height: x = (a - y) / k: ok = IsBetween(x, sh.Left, sh.Left + sh.Width)
      If ok Then s = s & vbLf & sh.Name
   
       
    End If
    Next

  Range("P5:P20").Value = Application.Transpose(Split(Mid(s, 2), vbLf))
  Range("P5:P20").Replace "#N/A", ""
       Application.OnTime DateAdd("s", 3, Now), "Delete1"
 
     
     
End Sub


Function IsBetween(x#, x1#, x2#)
  IsBetween = x >= x1 And x <= x2
End Function

Sub Delete1()
    shp.Delete
    Range("P5:P33").ClearContents
    ActiveSheet.Calculate
End Sub

Записан
Страниц: [1]   Вверх
Печать
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru