Страницы: 1
RSS
Как удалить конкретную стрелку (нарисованная линия с окончанием в виде стрелки)
 
Уважаемые форумчане, помогите решить такую проблему: На рабочем листе, стрелки (нарисованная линия с окончанием в виде стрелки) постоянно должны создаваться /перемещаться (по принципу drag-and-drop) /удаляться, и в каждый момент времени на листе стрелок может быть абсолютно разное количество.

С созданием стрелок проблем нет - каждая из них создается из конкретной активной ячейки с помощью макроса
Код
ActiveCell.Select
With ActiveSheet.Shapes.AddLine(Selection.Left + Selection.Width / 2, Selection.Top + Selection.Height / 2, Selection.Left + Selection.Width / 2 + 50, Selection.Top + Selection.Height / 2 + 50).Line
        .EndArrowheadStyle = msoArrowheadTriangle
        .ForeColor.RGB = RGB(0, 0, 0)
        .Weight = 1
End With
Заранее хочу сообщить что я в VBA новенькая, и для опытных этот код наверняка покажется г.... кодом. Но главное, что он свое дело делает.

Перемещение  (по принципу drag-and-drop) выполняется мышью.

А вот с удалением стрелок проблема. Подскажите, как можно макросом удалить стрелку, которая начинается из конкретной ячейки? (т е чтобы в коде идентификация удаляемой стрелки (перед удалением) определялась от конкретной ячейки, в которой расположено начало стрелки, и только потом стрелка удалялась). Также если из конкретной ячейки начинаются две и более стрелок, то они тоже должны быть удалены.

Заранее спасибо всем откликнувшимся!
 
Не видно (нет файла), как у Вас расположены стрелки, но общее направление такое: перебираем циклом все стрелки и проверяем, совпадает ли .topleftcell.address фигуры с адресом активной ячейки. Если совпадает - delete.
 
Не совсем поняла как это сделать  - почитала про .topleftcell.address и написано, что он возвращает объект Range, который представляет ячейку, расположенную в верхнем левом углу указанного объекта (т е как я поняла, стрелки). А в моём случае нужная ячейка может быть с любой стороны объекта.
Прикрепила файл где постаралась максимально подробно описать ситуацию как могла
 
Цитата
Алина С написал:
Прикрепила файл
не прикрепился
Соблюдение правил форума не освобождает от модераторского произвола
 
что-то не загрузился файл - повторяюсь
 
Алина С, я лишь предложил принцип. Topleftcell подойдёт для случая, когда стрелка начинается из активной ячейки и направлена во вторую четверть окружности (квадрант). По другим направлениям нужно будет добавлять проверки, но готового решения у меня нет.
 
Алина С, Посмотрите решение тут
Только для вашего решения нужно инвертировать все
 
Цитата
Алина С написал:
А в моём случае нужная ячейка может быть с любой стороны объекта.
не совсем, стрелка всегда является диагональю , даже если один из катетов 0. Далее для направления она переворачивается вертикально и/или горизонтально, сто определяет куда смотрит влево/вправо и вверх/вниз.  Если определили, то определить адрес ячейки из TopLeft и ButtomRight  -  не сложно. Далее проверка с нужной ячейкой и удаление. как  и написал Юрий.
Изменено: БМВ - 01.08.2021 21:43:02
По вопросам из тем форума, личку не читаю.
 
Цитата
Юрий М "я лишь предложил принцип. Topleftcell подойдёт для случая, когда стрелка начинается из активной ячейки и направлена во вторую четверть окружности (квадрант).
Спасибо! Для решения проблемы любые идеи ценны
Изменено: Алина С - 02.08.2021 16:33:19
 
БМВ, если я Вас правильно поняла, то нужно перебирать все shape (стрелки) на листе, и у каждой стрелки возвращать адрес ячеек начала и конца (через  TopLeft и ButtomRight ), и если адрес одной из таких ячеек начала/конца совпадет с активной ячейкой, то в этом случае можно идентифицировать стрелку, и тогда ее уже удалять?
 
Алина С,  ну это еще Юрий предложил, я только расширил, что для поиска адреса начала стрелки нужно немного посчитать. в №7 код нахождения, хоть я б записал по другому ибо нечего булевы в текст преобразовывать, но смысл примерно  тот же.
По вопросам из тем форума, личку не читаю.
 
С миру по нитке получилось сделать работоспособный код (можно посмотреть работу на  листе  2), за что спасибо всем участникам: Константин Пак, Юрий М, БМВ . Подскажите, можно ли сделать так, чтобы переборе всех shape листа перебирать только стрелки, а не все подряд?
 
Думаю, что перебирать придётся все. И проверять н, например, наличие в имени подстроки.
В общем случаем так: Если имя содержит "Straight Connector "...
 
Цитата
БМВ написал:
хоть я б записал по другому ибо нечего булевы в текст преобразовывать,

Код
Sub удаление_стрелки()
Dim s As Shape
    For Each s In ActiveSheet.Shapes
        If s.Type = msoLine Then
            If ActiveCell.Address = CellFromArrow(s).Address Then s.Delete
        End If
    Next
End Sub


Function CellFromArrow(ByVal s As Shape) As Range
    With s
        Set CellFromArrow = .Parent.Cells( _
        IIf(.VerticalFlip, .BottomRightCell.Row, .TopLeftCell.Row), _
        IIf(.HorizontalFlip, .BottomRightCell.Column, .TopLeftCell.Column))
    End With
End Function
Изменено: БМВ - 04.08.2021 12:37:08
По вопросам из тем форума, личку не читаю.
 
БМВ, Как же убого смотрится мой код по сравнению с Вашим. Всё чётко работает. Всем спасибо. Тема закрыта.
Страницы: 1
Наверх