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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос расстановки цветов - как аналог УФ - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос расстановки цветов - как аналог УФ (Макросы/Sub)
Макрос расстановки цветов - как аналог УФ
mv6677 Дата: Воскресенье, 06.05.2018, 20:38 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 71
Репутация: 3 ±
Замечаний: 0% ±

Excel 2013
Здравствуйте.
Подскажите с решением вопроса.

Есть такой макрос вба, который в заданном диапазоне Z6:AP28 - проводит что-то вроде условного форматирования.
Если видит 1, то ставит зеленый цвет. А если видит 0 - то ставит белый цвет шрифта.
Но он работает с простым цветом.

Скажите - как научить этот макрос аналогичным образом провести такую же расстановку цветов - в диапазоне E6:R28, где нужна сложная заливка ?
(То есть там - белый цвет - градиентно переходит в желтый, или белый в серый.)
К сообщению приложен файл: -2-.xls(48.0 Kb)
 
Ответить
СообщениеЗдравствуйте.
Подскажите с решением вопроса.

Есть такой макрос вба, который в заданном диапазоне Z6:AP28 - проводит что-то вроде условного форматирования.
Если видит 1, то ставит зеленый цвет. А если видит 0 - то ставит белый цвет шрифта.
Но он работает с простым цветом.

Скажите - как научить этот макрос аналогичным образом провести такую же расстановку цветов - в диапазоне E6:R28, где нужна сложная заливка ?
(То есть там - белый цвет - градиентно переходит в желтый, или белый в серый.)

Автор - mv6677
Дата добавления - 06.05.2018 в 20:38
Апострофф Дата: Воскресенье, 06.05.2018, 21:29 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 154
Репутация: 56 ±
Замечаний: 0% ±

Excel 2003
mv6677, вот вам пример сложной заливки для одного значения-
[vba]
Код
Sub Макрос2()
Dim c As Range
For Each c In [e6:r28]
    If c = 1 Then
      With c.Interior
          .Pattern = xlPatternLinearGradient
          .Gradient.Degree = 45
          With .Gradient.ColorStops
              .Clear
              .Add(0).Color = vbWhite
              .Add(1).Color = 65535
          End With
      End With
    End If
Next
End Sub
[/vba]


Сообщение отредактировал Апострофф - Воскресенье, 06.05.2018, 21:43
 
Ответить
Сообщениеmv6677, вот вам пример сложной заливки для одного значения-
[vba]
Код
Sub Макрос2()
Dim c As Range
For Each c In [e6:r28]
    If c = 1 Then
      With c.Interior
          .Pattern = xlPatternLinearGradient
          .Gradient.Degree = 45
          With .Gradient.ColorStops
              .Clear
              .Add(0).Color = vbWhite
              .Add(1).Color = 65535
          End With
      End With
    End If
Next
End Sub
[/vba]

Автор - Апострофф
Дата добавления - 06.05.2018 в 21:29
mv6677 Дата: Воскресенье, 06.05.2018, 22:11 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 71
Репутация: 3 ±
Замечаний: 0% ±

Excel 2013
Апострофф, подскажите - как две проверки в один код совместить, чтобы не писать два раза For Each c In [E6:R28] ?

[vba]
Код

Sub Макрос4()
Dim c As Range
For Each c In [E6:R28]
    If c = 0.5 Then
    With c.Interior
        .Pattern = xlPatternLinearGradient
        .Gradient.Degree = 45
        With .Gradient.ColorStops
            .Clear
            .Add(0).Color = vbWhite
            .Add(1).ThemeColor = xlThemeColorDark2
            .Add(1).TintAndShade = -0.250984221930601
        End With
    End With
    End If
Next

For Each c In [E6:R28]
    If c = 1 Then
    With c.Interior
        .Pattern = xlPatternLinearGradient
        .Gradient.Degree = 45
        With .Gradient.ColorStops
            .Clear
            .Add(0).Color = vbWhite
            .Add(1).Color = 65535
        End With
    End With
    End If
Next

End Sub
[/vba]
К сообщению приложен файл: -3-.xls(52.5 Kb)


Сообщение отредактировал mv6677 - Понедельник, 07.05.2018, 01:01
 
Ответить
СообщениеАпострофф, подскажите - как две проверки в один код совместить, чтобы не писать два раза For Each c In [E6:R28] ?

[vba]
Код

Sub Макрос4()
Dim c As Range
For Each c In [E6:R28]
    If c = 0.5 Then
    With c.Interior
        .Pattern = xlPatternLinearGradient
        .Gradient.Degree = 45
        With .Gradient.ColorStops
            .Clear
            .Add(0).Color = vbWhite
            .Add(1).ThemeColor = xlThemeColorDark2
            .Add(1).TintAndShade = -0.250984221930601
        End With
    End With
    End If
Next

For Each c In [E6:R28]
    If c = 1 Then
    With c.Interior
        .Pattern = xlPatternLinearGradient
        .Gradient.Degree = 45
        With .Gradient.ColorStops
            .Clear
            .Add(0).Color = vbWhite
            .Add(1).Color = 65535
        End With
    End With
    End If
Next

End Sub
[/vba]

Автор - mv6677
Дата добавления - 06.05.2018 в 22:11
Karataev Дата: Понедельник, 07.05.2018, 10:07 | Сообщение № 4
Группа: Проверенные
Ранг: Старожил
Сообщений: 1232
Репутация: 464 ±
Замечаний: 0% ±

Excel


Киви-кошелек: 9166309108
Яндекс-деньги: 410014131888288
 
Ответить
Сообщение

Автор - Karataev
Дата добавления - 07.05.2018 в 10:07
mv6677 Дата: Понедельник, 07.05.2018, 11:25 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 71
Репутация: 3 ±
Замечаний: 0% ±

Excel 2013
Karataev, заработало, спасибо.
 
Ответить
СообщениеKarataev, заработало, спасибо.

Автор - mv6677
Дата добавления - 07.05.2018 в 11:25
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос расстановки цветов - как аналог УФ (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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