Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Создание фигур и их цветовая заливка по условиям, Создание фигур из перечня, нанесение на карту и их заливка цветом по условному форматированию
 
#1
16.11.2023 18:28:13
Всем добрый вечер. Прошу помощи в корректировке макроса.
Задача:
Есть перечень наряд-допусков, которые необходимо визуализировать на карте объекта. В перечне указаны №НД (колонка В) и тип НД (колонка Н). Необходимо создать фигуры (овал) на карте, привязать их к №НД и залить соответствующим цветом по условному форматированию типа НД.
Проблема:
Как создать фигуры и привязать их к №НД я разобрался. Прошу помочь с цветовой заливкой.
На примере (взятом с этого форума) у меня все работает - Закраска2.xlsm.
А вот с моей задачей зашёл в тупик.
За ранее благодарю.
 
 
 
#2
16.11.2023 21:16:20
Здравствуйте.
Не знаю, так ли понял.
Код
Sub Macros2()
Dim i As Long, a As Variant
With Sheets("Перечень")
    For i = 21 To 34
        a = .Cells(i, 8).DisplayFormat.Interior.Color
        Sheets("Карта").Shapes(.Cells(i, 2).Value).Fill.ForeColor.RGB = a
    Next
End With
Sheets("Карта").Select
End Sub
 
 
 
#3
16.11.2023 22:03:47
спасибо за комментарий.

В файле "Закраска2.xlsm" макросы (Private Sub и Sub) как раз и работают. А вот в файле "Привязка НД карте - черновик.xlsm" тот же макрос Private Sub выдаёт ошибку. Думаю проблема именно в создании фигур - в первом файле (Закраска2...)  они уже созданы на карте, в во втором (Привязка...) я их создаю макросом Sub.

И мне нужен плавающий Range в столбце Н перечня НД, т.к. перечень постоянно обновляется и изменяется. Так что фиксированный перебор i от 21 до 34 не подходит. Но я эту задачу решил.

Попробую применить ваш алгоритм цикла For....
 
 
 
#4
16.11.2023 22:37:24
Применил ваш алгоритм.

1) в файле Заливка3... все работает!!

2) в файле Привязка НД карте... макрос выдаёт ошибку - Индекс указанного набора выходит за допустимые пределы.

'    Dim j As Long, a As Variant
'    
'    With Sheets("Перечень НД")
'         For j = 21 To lLastRow
'               a = .Cells(j, 8).DisplayFormat.Interior.Color
'               Sheets("Карта БС").Shapes(.Cells(j, 2).Value).Fill.ForeColor.RGB = a
'         Next
'    End With
   
   
Поэтому не совсем понимаю где ошибка.
 
 
 
#5
16.11.2023 23:02:21
Он ругается потому что рисунки названы числами, нужен текст. Исправьте строку

Sheets("Карта БС").Shapes(.Cells(j, 2).Text).Fill.ForeColor.RGB = a

 
 
 
#6
16.11.2023 23:03:39
Разделил выполнение задачи на 2 макроса, как было предложено.
Ошибка больше не появляется, но и обновление заливки фигур не происходит.  
 
 
 
#7
16.11.2023 23:10:44
Большое СПАСИБО!!! все заработало!!! и разделение на 2 макроса не надо.
 
 
 
#8
17.11.2023 20:08:53
Добрый вечер. Порошу ещё раз помочь и посоветовать как скорректировать макрос.
Дело в том, что я не учёл фильтрацию перечня НД. Макрос прекрасно работает с фиксированной таблицей. Но если её отфильтровать по условию (скрыть строки), то он все равно создаёт все фигуры, а не отфильтрованные.

Разобрался как найти первую активную строку (после первых скрытых от шапки перечня). Но как создать цикл для дальнейшего создания только отфильтрованных фигур и их заливки, у меня не получается.

Прошу помочь. Файл во вложении.
За ранее благодарю.    
 
 
 
#9
17.11.2023 21:35:47
Добрый.
С массивами плохо у меня получается, по этому убрал массив и сделал всё циклом на листе.
Код
    With Sheets("Перечень НД")
    i = 21
        For j = 21 To lLastRow
            a = .Cells(j, 8).DisplayFormat.Interior.Color
            If .Rows(j).Hidden = False Then
            With Sheets("Карта БС").Shapes.AddShape(msoShapeOval, 50, i * 50, 40, 40)
                .Name = Sheets("Перечень НД").Cells(j, 2).Text
            End With
            Sheets("Карта БС").Shapes(.Cells(j, 2).Text).Fill.ForeColor.RGB = a
            i = i + 1
            End If
        Next
    End With  
 
 
 
#10
17.11.2023 22:17:28
Огромное спасибо! Все работает. Только i=1 поправил для начала цикла.
 
 
 
#11
19.11.2023 21:17:28
Добрый вечер.
Прошу очередной помощи по данному файлу \ макросу. В принципе осталось только расставить фигуры на карте по координатам объектов. Сами координаты объектов уже автоматически считаются и записываются в таблицу на листе "Ссылки".

Вижу следующий алгоритм цикла:
1) сравниваем, есть и нет номера фигур на листе "Карта...", с перечнем НД (столбец В). учитываем скрытые строки в перечне.
2) если да, сравниваем в перечне соответствующее место проведения работ (столбец С) с наименованием объектов на листе "Ссылки" в столбце А - по частичному совпадению имени  - например *STF*, *GTU*, *SPR-100*.    
3) если совпадение есть, переносим фигуры на листе "Карты..." по координатам, указанным на листе "Ссылки" в столбцах В,С.
4) при очередном цикле, если фигура уже перенесена, делаем отступ по Y

Прошу помочь. Файл во вложении.
За ранее благодарю.  
 
 
 
#12
19.11.2023 22:38:02
Здравствуйте.
Мне не понятны эти проверки. Если вы создаете фигуры, при создании проверяете на скрытие строк, и знаете где эти фигуры должны размещаться, то почему сразу их туда не поместить после создания, присвоения имени и закраски. Или у вас какая то другая логика?
 
 
 
#13
19.11.2023 22:51:41
В принципе согласен с вами. макрос писался поэтапно. я пытался вставить привязку фигур к координатам объектов в ранее разработанный цикл (по созданию фигур и заливке), но не нашёл решения как это сделать.  
 
 
 
#14
19.11.2023 23:26:26
Может это добавить ниже закраски?
Код
         With Sheets("Карта БС") 'Перемещение по координатам
                    Kor = Sheets("Ссылки").Columns(4).Find(What:=rr, LookIn:=xlValues).Row
                   .Shapes(rr).Left = Sheets("Ссылки").Cells(Kor, 2)
                   .Shapes(rr).Top = Sheets("Ссылки").Cells(Kor, 3) ' + s      ' координаты Y
         End With
Изменено: gling - 19.11.2023 23:26:44
 
 
 
#15
20.11.2023 09:40:36
Спасибо. В принципе схема рабочая. Но сначала надо проверить фигуры по ключевому слову (*STF*, *GTU*) в листе "Перечень..." колонка В и сравнить с листом "Ссылка" колонка А. Если есть совпадение - записать имя фигуры в "Ссылка" колонка D в соответствующую строку. Так мы привязываем фигуру к ye;yjve объекту \ месту работы. Если есть пустые строки в колонке D, то игнорируем. Поможете?  
 
 
 
#16
20.11.2023 09:54:51
Тема по раскраске фигур наверно закончилась, начинается тема по привязке объектов на листе по координатам. Думаю что надо создать новую тему и там более подробно объяснить что вы хотите. Проверка на наличие определенного текста в файле уже есть (строкам с Find), можно её использовать где надо.
Пока не понимаю для чего нужна проверка  описанная в посте #15 и откуда возьмутся координаты. Пока не понятно.
Цитата
написал:
Поможете?
Если получится.
 
 
 
Страницы: 1
Наверх