Автор Тема: Excel VBA Макросы: Изменение ширины шейпа по координатам другого шейпа.  (Прочитано 47 раз)

Оффлайн radioamator

  • Посетитель форума
  • Сообщений: 2
Имеется макрос, растягивающий прямоугольник до уровня шейпа 'Овал'.
То есть можно перетаскивать шейп, и после срабатывания макроса прямоугольник будет или растягиваться вправо или укорачиваться справа. В зависимости от того, где стоит шейп 'Овал'.

Но если поместить шейп 'Овал' по левую сторону от фигуры, то строка
r1.Width = t.Left - r1.Left
уже не сработает, поскольку действует она только в одну сторону.

Подскажите - как подгонять макросом размеры прямоугольника, если овал стоит по левую сторону от него?

Оффлайн Администратор

  • Administrator
  • Сообщений: 1574
Макрос
Sub test1()

    Dim oval As Shape, rec As Shape
    Dim OvalRight As Double, dif As Double
   
   
    ' Присваиваем фигурам имена, чтобы удобнее читать и писать код.
        ' Далее в коде будем обращаться к фигурам по этим именам.
    Set oval = ActiveSheet.Shapes("Овал")
    Set rec = ActiveSheet.Shapes("Прямоугольник")
   
    ' Расчёт положения правой стороны овала.
    OvalRight = oval.Left + oval.Width
   
    ' Если правая сторона овала левее прямоугольника.
    If OvalRight < rec.Left Then
        dif = rec.Left - OvalRight
        rec.Left = OvalRight
        rec.Width = rec.Width + dif
    ' Если правая сторона овала совпадает с левой стороной прямоугольника или
        ' правая сторона овала правее левой стороны прямоугольника.
    Else
        rec.Width = oval.Left - rec.Left
    End If

End Sub

Оффлайн radioamator

  • Посетитель форума
  • Сообщений: 2