Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Макрос записывает в таблицу несоответствующие названия фигур
 
Доброго дня.
Есть вот такой макрос.
Он записывает в таблицу P5:P20 - названия фигур, которые пересекает линия.
Однако этот макрос - записывает в таблицу - также и некоторые другие названия фигур - которые линия не пересекает.
А иногда еще и повторяет в таблице одно и то же название несколько раз.

Почему так происходит и как изменить макрос, чтобы он записывал в таблицу P5:P20 - только те фигуры, которые линия пересекает ?
 
сейчас переменные в макросе обявлены глобально - поэтому в переменной S хранятся те названия, что уже попадались, и с каждым след выполнением добавляются все новые и новые
"обнуляйте" S в начале выполнения процедуры, или закомментируйте глобальные обьяления и раскомментируйте локальные, как было раньше)
и...
перед выводом результатов проверте, не пуста-ли S
и...
мое предложение в силе)
в анкетах по трудоустройству на должность программиста встречается вопрос:
"Как часты Вы подвергались административным взысканиям за хранение данных в глобальных переменных?"
Изменено: Ігор Гончаренко - 12 Янв 2019 12:59:13
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко,обнулил s - как вы сказали.
Скрипт теперь выглядит так:
Код
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
  'MsgBox shp.Name & " intersect next:" & vbLf & s, , "Look at this"
  'Range("P5:P10").Value = Application.Transpose(s)
  'Debug.Print s

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

Результат тот же:
По-прежнему записывает в таблицу - также и другие названия фигур - которые линия не пересекает.
 
линия (прямая) - как раз пересекает, а вот если рассмотреть заданный отрезок (или вектор) - то нет!
корректно сформулированная задача - залог получения точного ответа
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Ігор Гончаренко написал:
линия (прямая) - как раз пересекает, а вот если рассмотреть заданный отрезок
Какой отрезок ?
Разве в экселе есть объект с названием "Отрезок" ?
Наведите мышкой на кнопку рисования линии - и там будет написано "Линия", а не "Отрезок".

Я спрашивал вот про этот самый тип объекта.
 
в геометрии есть понятия: отрезок, вектор, прямая
все они могут быть заданы одним уравнением: у = Кх + А
только у отрезка и ветора есть длина, у ветора есть еще направление, а прямая - бесконечна
Изменено: Ігор Гончаренко - 12 Янв 2019 18:57:37
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Lizard2,  Вам Ігор Гончаренко пытается сказать, что линия в excel на самом деле отрезок, а он имеет конечные точки и следовательно может просто не добраться до фигуры. То что написали Line / Линия думаю просто сократили, не писать же "line segment" , а переводят часто не адаптируя.
Страницы: 1
Читают тему (гостей: 1)
Наверх