График работ

[koda]

Добрый день.

Прошу помощи, сделал «график работ» в котором отображается определенная компания когда была оплата, какой слесарь делает, конечный срок и т.д. Справа в календаре рисуется график, построен он на «условное форматирование». Проблема в том что хотелось что бы этот график был цветным в зависимости от того какой слесарь делает объект. Нашел макрос который заменяет «условное форматирование» но как реализовать его в графике не знаю.

[Serge_Bliznykov]

замените Ваш код на следующий:

Private Sub Worksheet_Change(ByVal Target As Range)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Author Russell Hauf, Beaverton, Oregon, USA              '
' Автор Рассел Гауф, Бивертон, Орегон, США                 '
'                                                          '
' тому, кто уберет автора, лично оторву шаловливые ручонки '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Этот макрос реализует условное форматирование
' с более чем 3-мя условиями.
    Dim rng As Range
' Исходный диапазон может содержать более чем 1 ячейку,
' поскольку он задается как пересечение диапазонов Target
' и D:D. Благодаря этому макрос будет выполняться корректно
' при удалении содержимого нескольких ячеек столбца D или
' вводе значений нескольких ячеек столбца D в виде массива.
    Set rng = Intersect(Target, Range("C:C"))
    If rng Is Nothing Then
       Exit Sub
    Else
        Dim cl As Range
        Dim clInd As Integer
        
        For Each cl In rng
            On Error Resume Next
' Если содержимое ячейки отсутствует
' в диапазоне rngColors, ее заливка удаляется.
            clInd = Application.WorksheetFunction.VLookup(cl.Value, _
ThisWorkbook.Sheets("Праздники").Range("rngColors"), _
2, False)
            
            If Err.Number = 0 Then
              cl.Interior.ColorIndex = clInd
               If cl.Row > 6 Then
                   Application.EnableEvents = False
                   Application.ScreenUpdating = False
                   Dim cl2 As Range
                   For Each cl2 In Range(Cells(cl.Row, "L"), Cells(cl.Row, "CY"))
                      cl2.FormatConditions(1).Interior.ColorIndex = clInd
                   Next cl2
                   Application.EnableEvents = True
                   Application.ScreenUpdating = True
                End If
            Else
               cl.Interior.ColorIndex = xlNone
            End If
        Next cl
    End If
End Sub

фокус в замене цвета условного форматирования на нужный в момент смены мастера (т.е., пока мастера не поменяешь - цвет не поменяется!)

[дмидми]

(В сторону.)
Что-то я сегодня разъехидничался...
(Громко.)
Отрывать шаловливые ручонки - это, может быть, и хорошо, но наверняка ещё лучше было бы привести комментарии в соответствие с кодом:

' Исходный диапазон...задается как пересечение диапазонов Target
' и D:D...
Set rng = Intersect(Target, Range("C:C"))

, не говоря уже обо всём остальном, вроде невероятного для нормального кода количества невынесенных к заголовку констант ("L", "CY"), действительных только для какого-то конкретного и давно уже никому не нужного случая.

Кстати, а на кой ляд вообще сдалось условное форматирование, если прямое и вполне себе безусловное форматирование выполняется из кода?

[Serge_Bliznykov]

по поводу автора и шаловливых ручек - это было в исходном файлике. поэтому я и побоялся трогать этот комментарий - за свои ручки опасался;-))))

Сообщение от дмидми

Кстати, а на кой ляд вообще сдалось условное форматирование, если прямое и вполне себе безусловное форматирование выполняется из кода?

дмидми, вопрос, надеюсь - не ко мне?! ;-)
потому как мне лень было менять условное форматирование на безусловное... так ещё и диаазон слежения в work_change пришлось бы расширять (на даты)... а так - решение задачи минимальным (я бы сказал - "хирургическим", вмешательством ;-))