Страницы: 1
RSS
Макрос неточно расставляет объекты по листу
 
Добрый вечер, форумчане.
Помогите разобраться с макросом.

Макрос сейчас расставляет фигуры - размещая их над красными точками с определенным названием.
Названия фигур и названия соответствующих красных точек - вписаны в таблицу AB10:AC16

Однако по идее - скрипт должен расставить фигуры по всем точкам с одинаковым названием.
Но так не происходит.   Выбирается одна точка с названием "Приемный узел1" (хотя таких точек на листе множество) - и на эту точку копируется фигура.
По идее - копия должна была быть размещена - на каждой точке с названием "Приемный узел1".

Почему это происходит и как это исправить ?
 
Доброе время суток
Цитата
radioamator написал:
По идее - копия должна была быть размещена - на каждой точке с названием "Приемный узел1".
А Excel что-нибудь знает об этой идее? А если не знает, то делает ровно то, что вы ему указали. Следовательно, это не макрос не точно расставляет, а вы не точно указываете.
Изменено: Андрей VG - 03.09.2019 17:45:20
 
Цитата
Андрей VG написал:
Следовательно, это не макрос не точно расставляет, а вы не точно указываете.
А как указать правильно ?
 
Цитата
radioamator написал:
Почему это происходит и как это исправить ?
так происходит потому, что кто-то кому-то неточно обьяснил условия задачи
как исправить?
обьясниь автору кода корректные условия задачи, или учить VBA и исправить все самостоятельно
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, вы лучше скажите, как бы вы поправили данный скрипт.
Ну хотя бы в теоретическом виде.
 
я в теории не силен. я практик. разнес картинки по узлам
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, ясно.
Почему-то не работает.
Запускаю макрос - и фигуры - не расставляются по красным точкам.
 
воспользовался Вашим Private Sub NextCloneAndMove(ByVal Source As Shape, ByVal Target As Shape)
он корректно все ставит на места, согласно рисунка
Изменено: Ігор Гончаренко - 03.09.2019 19:03:56
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Ігор Гончаренко написал:
воспользовался Вашим Private Sub NextCloneAndMove(ByVal Source As Shape, ByVal Target As Shape)
Так я тоже пользуюсь тем же самым Private Sub NextCloneAndMove
На места он фигуры - не ставит.
 
Цитата
radioamator написал:
На места он фигуры - не ставит.
Детальнее, будьте столь любезны. Опишите, что делает метод NextCloneAndMove
 
Андрей VG, ну человек пишет, что метод NextCloneAndMove - расставляет все фигуры по местам.

Я проверяю его слова.
Запускаю макрос Public Sub CloneAndMode()
Метод NextCloneAndMove - вызывается из макроса -  Public Sub CloneAndMode() - и он не расставляет все фигуры по местам.
Он расставляет только часть фигур по местам.
 
Цитата
radioamator написал:
Он расставляет только часть фигур по местам.
Тогда опишите этот метод, что он делает
 
Цитата
radioamator написал:
(хотя таких точек на листе множество)
Цитата
radioamator написал:
Выбирается одна точка с названием "Приемный узел1"
И будет выбираться одна - первая.
Создавайте коллекцию ваших точек, и расставляйте по ней, с учетом индекса. Или придумайте что либо аналогичное.
 
Андрей VG, этот метод определяет координаты узлов, указанных в столбце AB.

Копирует фигуру (по названию из столбца AC)

Вставляет копию этой фигуры в рассчитанные координаты (Source.Copy -  ActiveSheet.Paste) с учетом положения redPoint в конкретной группе (pClone.Left = destX: pClone.Top = destY)

Затем добавляет в название этой копии - некий длинный неповторяющийся текст, в котором используется текущее время (pClone.Name = pClone.Name & "_" & CStr(Timer * 1000)).
 
radioamator,
спорим на 500 руб. что все работает, с использованием
Private Sub NextCloneAndMove(ByVal Source As Shape, ByVal Target As Shape)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, так вы отдельно что ли Private Sub NextCloneAndMove запускаете ?

Он же уже и так запускается, в составе макроса Public Sub CloneAndMode()
 
Private Sub NextCloneAndMove(ByVal Source As Shape, ByVal Target As Shape)
работает как есть
в
Public Sub CloneAndMode()
добавляете 4-5 строк
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, я вас понял.

Давайте тогда спорим на 50р.
А то у меня таких сумм которые вы называете,  отродясь не бывало.
(перевел)
Изменено: radioamator - 04.09.2019 09:24:31
 
спасибо!
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, спасибо за ответ.

Но в вашем макросе - один "приемный узел" - игнорируется.
Это тот который стоит в верхнем левом углу (в составе группы).

Как на нем тоже разместить фигуру ?
 
это не самостоятельная фигура, это элемент группы. разгруппируйте - все сработает
и макрос не мой а Ваш)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, нет - этот узел должен находится именно в группе.

К тому же в первоначальном макросе, который размещен в первом сообщении - скрипт размещает фигуру именно в этом самом узле, несмотря на то, что этот узел находится в группе.
В вашем решении - эта функция уже не действует.
Так как же ее вернуть ?
 
замените макрос:на этот
Код
Public Sub CloneAndMode()
On Error Resume Next
    Dim pLo As ListObject, sp As Shape, sourceNames, targetNames, i As Long
    sourceNames = Range("AC10:AC16").Value
    targetNames = Range("AB10:AB16").Value
    NextCloneAndMove ActiveSheet.Shapes(sourceNames(1, 1)), ActiveSheet.Shapes(targetNames(1, 1))
    For i = 1 To UBound(sourceNames)
      If sourceNames(i, 1) <> "" Then
        For Each sp In ActiveSheet.Shapes
          If sp.Name = targetNames(i, 1) Then NextCloneAndMove ActiveSheet.Shapes(sourceNames(i, 1)), sp
        Next
      End If
    Next
    ActiveSheet.Range("A1").Select
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, спасибо.

Но пока что, все равно почему-то происходит игнорирование узлов в сгруппированных фигурах.
В данном файле - видно, что игнорируются 2 узла.
 
Что же делать ?
Помогите.
 
разгруппировать
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Здравствуйте, у меня получилось так:
Скрытый текст
 
magistor8, спасибо вам большое.
Прямо сходу все заработало.
Страницы: 1
Наверх