Изменение макроса расставляющего квадраты по серединам линий

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Изменение макроса расставляющего квадраты по серединам линий (Макросы/Sub)

КошкаСофи

Дата: Среда, 28.08.2019, 05:08 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 29

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Здравствуйте, специалисты по VBA.
Помогите изменить код.

Суть такая. На листе по-умолчанию - есть определенное количество линий, названия которых записаны в строке 9.
И я пытаюсь расставить по серединам этих линий - квадраты, названия которых - записаны (каждый под соответствующей линией) в строке 15.
Но не получается. приходится каждую фигуру, прописывать в макросе по имени. Но это не подходит, поскольку названия в строках 9 и 15 - постоянно меняются.

Как макросом - расставить по серединам линий - те квадраты, номера которых записаны в строке 15, без прописывания в коде - названия каждого из них ?

Макрос сейчас весьма примитивен и выглядит вот так:

[vba]

Код

Sub Линия()
On Error Resume Next
Dim Линия, Круг As Object
    Set Линия = ActiveSheet.Shapes("Овал 1|Овал 4")
    Set Круг = ActiveSheet.Shapes("Ф-Овал 1|Овал 4")
    Круг.Left = Линия.Width / 2 + Линия.Left - Круг.Width / 2
    Круг.Top = Линия.Height / 2 + Линия.Top - Круг.Height / 2
End Sub

Sub Линия2()
On Error Resume Next
Dim Линия, Круг As Object
    Set Линия = ActiveSheet.Shapes("Овал 4|Овал 3")
    Set Круг = ActiveSheet.Shapes("Ф-Овал 4|Овал 3")
    Круг.Left = Линия.Width / 2 + Линия.Left - Круг.Width / 2
    Круг.Top = Линия.Height / 2 + Линия.Top - Круг.Height / 2
End Sub

Sub Линия3()
On Error Resume Next
Dim Линия, Круг As Object
    Set Линия = ActiveSheet.Shapes("Овал 1|Овал 5")
    Set Круг = ActiveSheet.Shapes("Ф-Овал 1|Овал 5")
    Круг.Left = Линия.Width / 2 + Линия.Left - Круг.Width / 2
    Круг.Top = Линия.Height / 2 + Линия.Top - Круг.Height / 2
End Sub

Sub Макрос1()
Линия
Линия2
Линия3
End Sub

[/vba]

Код

[/vba]КошкаСофи

К сообщению приложен файл: 27347.xls (58.5 Kb)

Сообщение отредактировал КошкаСофи - Среда, 28.08.2019, 05:09

Ответить

СообщениеЗдравствуйте, специалисты по VBA.
Помогите изменить код.

Суть такая. На листе по-умолчанию - есть определенное количество линий, названия которых записаны в строке 9.
И я пытаюсь расставить по серединам этих линий - квадраты, названия которых - записаны (каждый под соответствующей линией) в строке 15.
Но не получается. приходится каждую фигуру, прописывать в макросе по имени. Но это не подходит, поскольку названия в строках 9 и 15 - постоянно меняются.

Как макросом - расставить по серединам линий - те квадраты, номера которых записаны в строке 15, без прописывания в коде - названия каждого из них ?

Макрос сейчас весьма примитивен и выглядит вот так:

[vba]

Код

[/vba]

Автор - КошкаСофи
Дата добавления - 28.08.2019 в 05:08

bmv98rus

Дата: Среда, 28.08.2019, 07:49 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4115

Репутация: 769 ±

Замечаний: 0% ±

Excel 2013/2016

КошкаСофи, там нарисовали линию, и сразу нужно нарисовать квадрат, не переместить ранее нарисованный, а нарисовать новый и вписать туда значение. в идеале лучше сразу сгруппировать его с линией.

~~Замечательный~~ Временно просто медведь ~~, процентов на 20~~.

Ответить

K-SerJC

Дата: Среда, 28.08.2019, 19:01 | Сообщение № 3

Группа: Проверенные

Ранг: Обитатель

Сообщений: 487

Репутация: 86 ±

Замечаний: 0% ±

Excel 2013

так?

К сообщению приложен файл: 4425222.xls (57.0 Kb)

Благими намерениями выстелена дорога в АД.

Сообщение отредактировал K-SerJC - Среда, 28.08.2019, 19:03

Ответить

КошкаСофи

Дата: Среда, 28.08.2019, 19:22 | Сообщение № 4

Группа: Пользователи

Ранг: Новичок

Сообщений: 29

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

K-SerJC, спасибо за ответ.

Пока - не работает.
Выдает ошибку: Run-time error 91: Object variable or With block not set

И подсвечивает строку:
[vba]

Код

Круг.Left = Линия.Width / 2 + Линия.Left - Круг.Width / 2

[/vba]
Квадраты на листе - изначально отсутствуют.
Им нужно сперва появиться на листе, затем расставиться по серединам линий.

К сообщению приложен файл: 4425222-2.xls (56.5 Kb)

Сообщение отредактировал КошкаСофи - Среда, 28.08.2019, 19:31

Ответить

K-SerJC

Дата: Четверг, 29.08.2019, 11:36 | Сообщение № 5

Группа: Проверенные

Ранг: Обитатель

Сообщений: 487

Репутация: 86 ±

Замечаний: 0% ±

Excel 2013

Цитата КошкаСофи, 28.08.2019 в 19:22, в сообщении № 4 ()

Квадраты на листе - изначально отсутствуют.
Им нужно сперва появиться на листе, затем расставиться по серединам линий.

в задании исходно был другой текст.
проверку по наличию исправил, но как у вас квадраты рисуются?

[vba]

Код

Sub Макрос1()
Dim Линия As Shape, Круг As Shape, f, square_, line_, sh, l, k
For f = 3 To 12
line_ = ThisWorkbook.Sheets(3).Cells(9, f).Value
square_ = ThisWorkbook.Sheets(3).Cells(15, f).Value
If line_ <> "" And square_ <> "" Then
For Each sh In ThisWorkbook.Sheets(3).Shapes
If sh.Name = line_ Then Set Линия = sh: l = True
If sh.Name = square_ Then Set Круг = sh: k = True
Next sh
If Not l Then MsgBox "нет линии - " & line_: Exit Sub
If Not k Then MsgBox "нет квадрата - " & square_: Exit Sub
Круг.Left = Линия.Width / 2 + Линия.Left - Круг.Width / 2
Круг.Top = Линия.Height / 2 + Линия.Top - Круг.Height / 2
End If
Next f
Set Линия = Nothing
Set Круг = Nothing
End Sub

[/vba]