Заливка фигуры условного формата на основе значения ячейки - PullRequest
Новая
       66

Заливка фигуры условного формата на основе значения ячейки

0 голосов
/ 02 августа 2020

Мне неприятно задавать этот вопрос, потому что я не знаю, с чего начать, поэтому у меня сейчас нет кода. Я видел кое-что о topi c, но не могу найти то, что ищу.

Таблица состоит из 5 столбцов (ID + количество болтов) x 13 строк (ID)

У меня есть четыре формы (Oval4-Oval7), которые я хотел бы изменить с красного / оранжевого / зеленого на четыре соответствующих ячейки (варианты значений этих ячеек: пустые, установленные, затянутые).

фигуры также изменят цвет в зависимости от выбранного идентификатора (1-13) в первом столбце.

Итак, если вы поместите курсор в ячейку с идентификатором 2, фигуры будут менять цвет в зависимости от значений в столбцах 2- 5 из того же ряда.

Это слишком сложно?

Я буду продолжать работать над этим сам. Просто подумал, что начну здесь.

Спасибо за ваше время.

Код ниже работает, но как мне применить его ко всей таблице? 

 Private Sub Worksheet_Change(ByVal Target As Range)
 If Range("d12") = "Empty" Then
 ActiveSheet.Shapes.Range(Array("Shape1")).Select
 Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
 Else
 If Range("d12") = "Installed" Then
 ActiveSheet.Shapes.Range(Array("Shape1")).Select
 Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 155, 0)
 Else
 If Range("d12") = "Torqued" Then
 ActiveSheet.Shapes.Range(Array("Shape1")).Select
 Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 255, 0)
 End If
 End If
 End If
 End Sub

введите описание изображения здесь

1 Ответ

0 голосов
/ 03 августа 2020

В модуле кода листа: 

Private Sub Worksheet_Change(ByVal Target As Range)
    ResolveSelection Target.Cells(1)
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ResolveSelection Target.Cells(1)
End Sub

'Is the selected/changed cell in one of the two tables?
'  If Yes get the full row for that cell and pass to SetRow
Sub ResolveSelection(Target As Range)
    Dim r, rng As Range
    For Each r In Array("B3:G14", "J3:O14") 'my 2 test tables
        Set rng = Application.Intersect(Target, Me.Range(r))
        If Not rng Is Nothing Then
            'get the whole row of the table
            Set rng = Application.Intersect(Target.EntireRow, Me.Range(r))
            SetRow rng
            Exit Sub
        End If
    Next r
End Sub

'set the coloring based on the row 'rw'
Sub SetRow(rw As Range)
    Dim i As Long, shp As Shape
    Debug.Print rw.Address
    For i = 1 To 4
        Set shp = rw.Parent.Shapes("Shape" & i)
        shp.Fill.ForeColor.RGB = GetColor(rw.Cells(2 + i).Value)
    Next i
End Sub

'get the color for a given state
Function GetColor(v As String) As Long
    Select Case v & ""
        Case "Empty", "": GetColor = vbRed
        Case "Installed": GetColor = RGB(255, 155, 0)
        Case "Torqued": GetColor = vbGreen
        Case Else: GetColor = vbWhite
    End Select
End Function
...