Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Перебор n фигур внутри групп - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Перебор n фигур внутри групп
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]

Спасибо.


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

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

Спасибо.

Автор - 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]
Код
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]

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

Автор - kotlovan
Дата добавления - 29.03.2023 в 11:03
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!