Перебор n фигур внутри групп

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перебор n фигур внутри групп (Макросы/Sub)

kotlovan

Дата: Среда, 29.03.2023, 09:57 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 30

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Добрый день, написал макрос для раскраски текста в фигурах в зависимости от значения.
Но он работает только для разгруппированных фигур. Как его заставить работать для группы фигур, +подгрупп в группах фигур?

[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]

Спасибо.kotlovan

Сообщение отредактировал kotlovan - Среда, 29.03.2023, 10:06

Ответить

СообщениеДобрый день, написал макрос для раскраски текста в фигурах в зависимости от значения.
Но он работает только для разгруппированных фигур. Как его заставить работать для группы фигур, +подгрупп в группах фигур?

[vba]

Код

[/vba]

Спасибо.

Автор - kotlovan
Дата добавления - 29.03.2023 в 09:57

kotlovan

Дата: Среда, 29.03.2023, 11:03 | Сообщение № 2

Группа: Пользователи

Ранг: Новичок

Сообщений: 30

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Получилось самому решить вот таким образом:

[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

[/vba]

Тему можно закрыть.

Получилось самому решить вот таким образом:

[vba]

Код

[/vba]

Тему можно закрыть.kotlovan

Ответить

СообщениеПолучилось самому решить вот таким образом:

[vba]

Код

[/vba]

Тему можно закрыть.

Автор - kotlovan
Дата добавления - 29.03.2023 в 11:03

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перебор n фигур внутри групп (Макросы/Sub)

Страница 1 из 1
1