Как условно отформатировать несколько фигур на основе нескольких ячеек в VBA (Автоматическое обновление фигур) - PullRequest
0 голосов
/ 15 мая 2019

Я проектирую панель мониторинга KPI, и мне нужно иметь 10+ фигур, которые меняют цвет в зависимости от значений ячейки.Я также хочу, чтобы цвета автоматически обновлялись.Моя проблема в том, что код, который я использую, может сделать это только с 2 фигурами на модуль / лист.

У меня также есть проблема с обновлением цветов: формы будут менять цвет только в том случае, если ячейка будет изменена в той же книге, что и форма.Когда я изменяю связанную ячейку из другой рабочей книги, ячейка в рабочей книге фигур обновляется, однако фигура не обновляется.

Я попытался скопировать код и изменить переменные, но, похоже, это не работает,Есть ли способ потенциально перебрать все формы и значения ячеек?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("B34", "B35")) Is Nothing Then Exit Sub
            If Sheets("M254 Daimler").Range("B34").Value >= 0.75 And Sheets("M254 Daimler").Range("B34").Value <= 0.84 Then
                            ActiveSheet.Shapes.Range(Array("Donut 10")).Select
                            With Selection.ShapeRange.Fill
                                .Visible = msoTrue
                                .ForeColor.RGB = RGB(255, 255, 0)
                                .Transparency = 0
                                .Solid
                            End With
                            With Selection.ShapeRange.Line
                                .Visible = msoTrue
                                .ForeColor.RGB = RGB(255, 255, 0)
                                .Transparency = 0
                            End With

            End If

            If Sheets("M254 Daimler").Range("B35").Value >= 0.75 And Sheets("M254 Daimler").Range("B35").Value <= 0.84 Then
                            ActiveSheet.Shapes.Range(Array("Donut 31")).Select
                            With Selection.ShapeRange.Fill
                                .Visible = msoTrue
                                .ForeColor.RGB = RGB(255, 255, 0)
                                .Transparency = 0
                                .Solid
                            End With
                            With Selection.ShapeRange.Line
                                .Visible = msoTrue
                                .ForeColor.RGB = RGB(255, 255, 0)
                                .Transparency = 0
                            End With

            End If
End Sub

Просто примечание: я вынул операторы elseif, так как они отформатированы так же, как операторы if и кодстановится немного повторяющимся со всеми условиями.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...