Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Изменение макроса расставляющего квадраты по серединам линий - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Изменение макроса расставляющего квадраты по серединам линий (Макросы/Sub)
Изменение макроса расставляющего квадраты по серединам линий
КошкаСофи Дата: Среда, 28.08.2019, 05:08 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 22
Репутация: 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]
К сообщению приложен файл: 27347.xls(58.5 Kb)


Сообщение отредактировал КошкаСофи - Среда, 28.08.2019, 05:09
 
Ответить
СообщениеЗдравствуйте, специалисты по 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]

Автор - КошкаСофи
Дата добавления - 28.08.2019 в 05:08
bmv98rus Дата: Среда, 28.08.2019, 07:49 | Сообщение № 2
Группа: Проверенные
Ранг: Участник клуба
Сообщений: 2528
Репутация: 437 ±
Замечаний: 0% ±

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


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

Автор - bmv98rus
Дата добавления - 28.08.2019 в 07:49
K-SerJC Дата: Среда, 28.08.2019, 19:01 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 456
Репутация: 74 ±
Замечаний: 0% ±

Excel 2013

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


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

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

так?

Автор - K-SerJC
Дата добавления - 28.08.2019 в 19:01
КошкаСофи Дата: Среда, 28.08.2019, 19:22 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 22
Репутация: 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, спасибо за ответ.

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

И подсвечивает строку:
[vba]
Код
Круг.Left = Линия.Width / 2 + Линия.Left - Круг.Width / 2
[/vba]
Квадраты на листе - изначально отсутствуют.
Им нужно сперва появиться на листе, затем расставиться по серединам линий.

Автор - КошкаСофи
Дата добавления - 28.08.2019 в 19:22
K-SerJC Дата: Четверг, 29.08.2019, 11:36 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 456
Репутация: 74 ±
Замечаний: 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]
К сообщению приложен файл: 0716271.xls(53.0 Kb)


Благими намерениями выстелена дорога в АД.
 
Ответить
Сообщение
Цитата КошкаСофи, 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]

Автор - K-SerJC
Дата добавления - 29.08.2019 в 11:36
K-SerJC Дата: Четверг, 29.08.2019, 13:07 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 456
Репутация: 74 ±
Замечаний: 0% ±

Excel 2013
так?
К сообщению приложен файл: 0629599.xls(69.5 Kb)


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

Сообщение отредактировал K-SerJC - Четверг, 29.08.2019, 13:09
 
Ответить
Сообщениетак?

Автор - K-SerJC
Дата добавления - 29.08.2019 в 13:07
КошкаСофи Дата: Четверг, 29.08.2019, 19:42 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 22
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
K-SerJC, большое спасибо.
 
Ответить
СообщениеK-SerJC, большое спасибо.

Автор - КошкаСофи
Дата добавления - 29.08.2019 в 19:42
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Изменение макроса расставляющего квадраты по серединам линий (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!