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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос для автоматического раскрашивания графика - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Power Point » Макрос для автоматического раскрашивания графика (Макросы/Sub)
Макрос для автоматического раскрашивания графика
Archy Дата: Четверг, 31.03.2016, 16:33 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Доброго времени суток!

Вопрос не совсем по екселю, но точно по бейсику)

Возникла задача, в Power Point необходимо, чтобы график (обычная диаграмма) окрашивался при отрицательных значениях в красный, при положительных в зеленый

График строится через графики самого Power point (связи с еселем нет).
[moder]Что за название темы? Переделывайте согласно п.2 Правил форума.


Сообщение отредактировал Archy - Четверг, 31.03.2016, 17:10
 
Ответить
СообщениеДоброго времени суток!

Вопрос не совсем по екселю, но точно по бейсику)

Возникла задача, в Power Point необходимо, чтобы график (обычная диаграмма) окрашивался при отрицательных значениях в красный, при положительных в зеленый

График строится через графики самого Power point (связи с еселем нет).
[moder]Что за название темы? Переделывайте согласно п.2 Правил форума.

Автор - Archy
Дата добавления - 31.03.2016 в 16:33
Manyasha Дата: Четверг, 31.03.2016, 17:54 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 1721
Репутация: 722 ±
Замечаний: 0% ±

Excel 2007, 2010
Archy, для двух цветов можно и без макроса: щелкаете ПКМ по ряду данных - формат ряда данных - Заливка: выбираете Сплошная заливка и ставите галочку "Инверсия для чисел <0". Выбираете цвет1 и цвет2.

Если будет больше условий, тогда макрос:
[vba]
Код
Sub setFormatCharts()
    'Цвета
    Dim clrGreen As Long: clrGreen = RGB(0, 142, 64)
    Dim clrGreenLight As Long: clrGreenLight = RGB(169, 225, 169)
    Dim clrYellow As Long: clrYellow = vbYellow
    Dim clrRed As Long: clrRed = RGB(192, 0, 0)
    
    For Each sl In ActiveWindow.Selection.SlideRange
        For Each sh In sl.Shapes
            If sh.HasChart Then
                For i = 1 To sh.Chart.SeriesCollection.Count
                    For j = 1 To sh.Chart.SeriesCollection(i).Points.Count
                        With sh.Chart.SeriesCollection(i).Points(j)
'                            On Error Resume Next
                            Select Case .DataLabel.Text
                    'Для Ваших условий
    '                            Case Is < 0: .Format.Fill.ForeColor.RGB = clrRed
    '                            Case Is > 0: .Format.Fill.ForeColor.RGB = clrGreen
                    
                    'Если будет больше условий
                    Case Is < -10: .Format.Fill.ForeColor.RGB = clrRed
                    Case -10 To 0: .Format.Fill.ForeColor.RGB = clrYellow
                    Case 0 To 10: .Format.Fill.ForeColor.RGB = clrGreenLight
                    Case Is > 10: .Format.Fill.ForeColor.RGB = clrGreen
                            End Select
                        End With
                    Next j
                Next i
            End If
        Next sh
    Next sl
End Sub
[/vba]
Макрос проходит по всем выделенным слайдам активной презентации, находит все диаграммы и красит ряды, основываясь на значения в подписях данных.
К сообщению приложен файл: primer.pptm(70Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеArchy, для двух цветов можно и без макроса: щелкаете ПКМ по ряду данных - формат ряда данных - Заливка: выбираете Сплошная заливка и ставите галочку "Инверсия для чисел <0". Выбираете цвет1 и цвет2.

Если будет больше условий, тогда макрос:
[vba]
Код
Sub setFormatCharts()
    'Цвета
    Dim clrGreen As Long: clrGreen = RGB(0, 142, 64)
    Dim clrGreenLight As Long: clrGreenLight = RGB(169, 225, 169)
    Dim clrYellow As Long: clrYellow = vbYellow
    Dim clrRed As Long: clrRed = RGB(192, 0, 0)
    
    For Each sl In ActiveWindow.Selection.SlideRange
        For Each sh In sl.Shapes
            If sh.HasChart Then
                For i = 1 To sh.Chart.SeriesCollection.Count
                    For j = 1 To sh.Chart.SeriesCollection(i).Points.Count
                        With sh.Chart.SeriesCollection(i).Points(j)
'                            On Error Resume Next
                            Select Case .DataLabel.Text
                    'Для Ваших условий
    '                            Case Is < 0: .Format.Fill.ForeColor.RGB = clrRed
    '                            Case Is > 0: .Format.Fill.ForeColor.RGB = clrGreen
                    
                    'Если будет больше условий
                    Case Is < -10: .Format.Fill.ForeColor.RGB = clrRed
                    Case -10 To 0: .Format.Fill.ForeColor.RGB = clrYellow
                    Case 0 To 10: .Format.Fill.ForeColor.RGB = clrGreenLight
                    Case Is > 10: .Format.Fill.ForeColor.RGB = clrGreen
                            End Select
                        End With
                    Next j
                Next i
            End If
        Next sh
    Next sl
End Sub
[/vba]
Макрос проходит по всем выделенным слайдам активной презентации, находит все диаграммы и красит ряды, основываясь на значения в подписях данных.

Автор - Manyasha
Дата добавления - 31.03.2016 в 17:54
Archy Дата: Пятница, 01.04.2016, 10:26 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Manyasha, Супер, все работает, огромное спасибо!
 
Ответить
СообщениеManyasha, Супер, все работает, огромное спасибо!

Автор - Archy
Дата добавления - 01.04.2016 в 10:26
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Power Point » Макрос для автоматического раскрашивания графика (Макросы/Sub)
Страница 1 из 11
Поиск:

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