Рисование фигуры - по диагонали определенной линии

Пользователь

Сообщений: 78 Регистрация: 11.09.2017

20.12.2017 07:42:38

Здравствуйте, уважаемые форумчане.
Помогите с макросом.

В файле - на рабочей области находится несколько линий.
Имеющийся макрос определяет координаты той линии, чье название записано в ячейку F2.

Как при помощи макроса - нарисовать фигуру "по диагонали", указанной в ячейке F2 линии ?
Чтобы фигура целиком охватывала линию.
(В приложенном макросе приложил внешний вид фигуры и то, как она должна быть нарисована.)

Прикрепленные файлы

Файл-пример.xls (46.5 КБ)

Alemox

Пользователь

Сообщений: 2184 Регистрация: 25.02.2013

20.12.2017 08:00:21

Код

Sub bb()
Dim PR, Lin As Shape

Set Lin = ActiveSheet.Shapes([F2])
Set PR = ActiveSheet.Shapes("Rounded Rectangular Callout 4")
PR.Left = Lin.Left
PR.Width = Lin.Width
PR.Height = Lin.Height
PR.Top = Lin.Top
  
End Sub

Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.

dotten12 Пользователь Сообщений: 78 Регистрация: 11.09.2017	#3 20.12.2017 08:06:03 Alemox, вы немного не так поняли. Вот этого объекта - "Rounded Rectangular Callout 4" - его изначально нет на листе (я просто его в файле - для наглядности изобразил). Его всякий раз нужно рисовать заново.

Karataev

Пользователь

Сообщений: 2311 Регистрация: 23.10.2014

21.12.2017 19:33:36

Код

Sub Вставить_выноску()
    Dim objShape As shape, objNewShape As shape
    Set objShape = ActiveSheet.Shapes(1)
    Set objNewShape = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangularCallout, _
        objShape.Left - 4, objShape.Top - 4, objShape.Width + 8, objShape.Height + 8)
    objNewShape.Fill.Visible = msoFalse
End Sub

dotten12 Пользователь Сообщений: 78 Регистрация: 11.09.2017	#5 21.12.2017 20:35:42 Karataev, ясно. Вроде теперь все заработало. Всем спасибо за ответы.

Читают тему