Добрый день, написал макрос для раскраски текста в фигурах в зависимости от значения. Но он работает только для разгруппированных фигур. Как его заставить работать для группы фигур, +подгрупп в группах фигур?
[vba]
Код
Sub ЦветаДашборда() Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 11) = "ВышеНуляБел" Then If Left(shp.TextFrame2.TextRange.Text, 1) = "+" Then shp.TextFrame.Characters.Font.Color = RGB(255, 255, 255) ElseIf Left(shp.TextFrame2.TextRange.Text, 1) = "0" Then shp.TextFrame.Characters.Font.Color = RGB(255, 255, 255) ElseIf Left(shp.TextFrame2.TextRange.Text, 1) = "-" Then shp.TextFrame.Characters.Font.Color = RGB(255, 80, 80) End If ElseIf Left(shp.Name, 11) = "ВышеНуляКрс" Then If Left(shp.TextFrame2.TextRange.Text, 1) = "+" Then shp.TextFrame.Characters.Font.Color = RGB(255, 80, 80) ElseIf Left(shp.TextFrame2.TextRange.Text, 1) = "0" Then shp.TextFrame.Characters.Font.Color = RGB(255, 255, 255) ElseIf Left(shp.TextFrame2.TextRange.Text, 1) = "-" Then shp.TextFrame.Characters.Font.Color = RGB(255, 255, 255) End If ElseIf Left(shp.Name, 11) = "ВышеНуляЗлн" Then If Left(shp.TextFrame2.TextRange.Text, 1) = "-" Then shp.TextFrame.Characters.Font.Color = RGB(197, 224, 180) ElseIf Left(shp.TextFrame2.TextRange.Text, 1) = "0" Then shp.TextFrame.Characters.Font.Color = RGB(197, 224, 180) Else shp.TextFrame.Characters.Font.Color = RGB(255, 80, 80) End If Else End If
Next
If CLng(Worksheets("Дашборд").Shapes("ЭПРП").TextFrame2.TextRange.Text) > CLng(Worksheets("Дашборд").Shapes("ЭПРПпг").TextFrame2.TextRange.Text) Then Worksheets("Дашборд").Shapes("ЭПРП").TextFrame.Characters.Font.Color = RGB(255, 80, 80) Else Worksheets("Дашборд").Shapes("ЭПРП").TextFrame.Characters.Font.Color = RGB(255, 255, 255) End If
End Sub
[/vba]
Спасибо.
Добрый день, написал макрос для раскраски текста в фигурах в зависимости от значения. Но он работает только для разгруппированных фигур. Как его заставить работать для группы фигур, +подгрупп в группах фигур?
[vba]
Код
Sub ЦветаДашборда() Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 11) = "ВышеНуляБел" Then If Left(shp.TextFrame2.TextRange.Text, 1) = "+" Then shp.TextFrame.Characters.Font.Color = RGB(255, 255, 255) ElseIf Left(shp.TextFrame2.TextRange.Text, 1) = "0" Then shp.TextFrame.Characters.Font.Color = RGB(255, 255, 255) ElseIf Left(shp.TextFrame2.TextRange.Text, 1) = "-" Then shp.TextFrame.Characters.Font.Color = RGB(255, 80, 80) End If ElseIf Left(shp.Name, 11) = "ВышеНуляКрс" Then If Left(shp.TextFrame2.TextRange.Text, 1) = "+" Then shp.TextFrame.Characters.Font.Color = RGB(255, 80, 80) ElseIf Left(shp.TextFrame2.TextRange.Text, 1) = "0" Then shp.TextFrame.Characters.Font.Color = RGB(255, 255, 255) ElseIf Left(shp.TextFrame2.TextRange.Text, 1) = "-" Then shp.TextFrame.Characters.Font.Color = RGB(255, 255, 255) End If ElseIf Left(shp.Name, 11) = "ВышеНуляЗлн" Then If Left(shp.TextFrame2.TextRange.Text, 1) = "-" Then shp.TextFrame.Characters.Font.Color = RGB(197, 224, 180) ElseIf Left(shp.TextFrame2.TextRange.Text, 1) = "0" Then shp.TextFrame.Characters.Font.Color = RGB(197, 224, 180) Else shp.TextFrame.Characters.Font.Color = RGB(255, 80, 80) End If Else End If
Next
If CLng(Worksheets("Дашборд").Shapes("ЭПРП").TextFrame2.TextRange.Text) > CLng(Worksheets("Дашборд").Shapes("ЭПРПпг").TextFrame2.TextRange.Text) Then Worksheets("Дашборд").Shapes("ЭПРП").TextFrame.Characters.Font.Color = RGB(255, 80, 80) Else Worksheets("Дашборд").Shapes("ЭПРП").TextFrame.Characters.Font.Color = RGB(255, 255, 255) End If
Sub ЦветаДашборда() 'узнаем количество фигур для красной раскраски и для зеленой раскраски на всём листе Dim shp As Shape Dim shpChild As Shape
For Each shp In ActiveSheet.Shapes If shp.Type = msoGroup Then For Each shpChild In shp.GroupItems If Left(shpChild.Name, 11) = "ВышеНуляБел" Then If Left(shpChild.TextFrame2.TextRange.Text, 1) = "+" Then shpChild.TextFrame.Characters.Font.Color = RGB(255, 255, 255) ElseIf Left(shpChild.TextFrame2.TextRange.Text, 1) = "0" Then shpChild.TextFrame.Characters.Font.Color = RGB(255, 255, 255) ElseIf Left(shpChild.TextFrame2.TextRange.Text, 1) = "-" Then shpChild.TextFrame.Characters.Font.Color = RGB(255, 80, 80) End If ElseIf Left(shpChild.Name, 11) = "ВышеНуляКрс" Then If Left(shpChild.TextFrame2.TextRange.Text, 1) = "+" Then shpChild.TextFrame.Characters.Font.Color = RGB(255, 80, 80) ElseIf Left(shpChild.TextFrame2.TextRange.Text, 1) = "0" Then shpChild.TextFrame.Characters.Font.Color = RGB(255, 255, 255) ElseIf Left(shpChild.TextFrame2.TextRange.Text, 1) = "-" Then shpChild.TextFrame.Characters.Font.Color = RGB(255, 255, 255) End If ElseIf Left(shpChild.Name, 11) = "ВышеНуляЗлн" Then If Left(shpChild.TextFrame2.TextRange.Text, 1) = "-" Then shpChild.TextFrame.Characters.Font.Color = RGB(197, 224, 180) ElseIf Left(shpChild.TextFrame2.TextRange.Text, 1) = "0" Then shpChild.TextFrame.Characters.Font.Color = RGB(197, 224, 180) Else shpChild.TextFrame.Characters.Font.Color = RGB(255, 80, 80) End If Else End If Next
[/vba]
Тему можно закрыть.
Получилось самому решить вот таким образом:
[vba]
Код
Sub ЦветаДашборда() 'узнаем количество фигур для красной раскраски и для зеленой раскраски на всём листе Dim shp As Shape Dim shpChild As Shape
For Each shp In ActiveSheet.Shapes If shp.Type = msoGroup Then For Each shpChild In shp.GroupItems If Left(shpChild.Name, 11) = "ВышеНуляБел" Then If Left(shpChild.TextFrame2.TextRange.Text, 1) = "+" Then shpChild.TextFrame.Characters.Font.Color = RGB(255, 255, 255) ElseIf Left(shpChild.TextFrame2.TextRange.Text, 1) = "0" Then shpChild.TextFrame.Characters.Font.Color = RGB(255, 255, 255) ElseIf Left(shpChild.TextFrame2.TextRange.Text, 1) = "-" Then shpChild.TextFrame.Characters.Font.Color = RGB(255, 80, 80) End If ElseIf Left(shpChild.Name, 11) = "ВышеНуляКрс" Then If Left(shpChild.TextFrame2.TextRange.Text, 1) = "+" Then shpChild.TextFrame.Characters.Font.Color = RGB(255, 80, 80) ElseIf Left(shpChild.TextFrame2.TextRange.Text, 1) = "0" Then shpChild.TextFrame.Characters.Font.Color = RGB(255, 255, 255) ElseIf Left(shpChild.TextFrame2.TextRange.Text, 1) = "-" Then shpChild.TextFrame.Characters.Font.Color = RGB(255, 255, 255) End If ElseIf Left(shpChild.Name, 11) = "ВышеНуляЗлн" Then If Left(shpChild.TextFrame2.TextRange.Text, 1) = "-" Then shpChild.TextFrame.Characters.Font.Color = RGB(197, 224, 180) ElseIf Left(shpChild.TextFrame2.TextRange.Text, 1) = "0" Then shpChild.TextFrame.Characters.Font.Color = RGB(197, 224, 180) Else shpChild.TextFrame.Characters.Font.Color = RGB(255, 80, 80) End If Else End If Next