Страницы: 1
RSS
Изменить на листе цвет заливки
 
Здравствуйте
Нужно найти на листе диапазоны с заливкой (Белый, Фон 1) и изменить на Без заливки
(у меня excel 2007)
Так конечно не получается:
Код
Sub НайтиБелыйЦветЗаливки()
Dim rng As Range
For Each rng In ActiveSheet.UsedRange.Cells
If rng.Interior.ThemeColor = xlThemeColorDark1 Then
    MsgBox "цвет заливки: Белый, Фон 1"
    rng.Interior.ThemeColor = xlNone
    MsgBox "цвет заливки: Нет заливки"
End If
Next rng
End Sub
если при записи макроса вручную делать цвет заливки (Белый, Фон 1):
Код
'цвет заливки: Белый, Фон 1
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
    
'цвет заливки: Нет заливки
With Selection.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
Пожалуйста, помогите поправить макрос
 
Попробуйте так:
Код
Sub НайтиБелыйЦветЗаливки()
Dim rng As Range
    For Each rng In ActiveSheet.UsedRange.Cells
        If rng.Interior.ColorIndex = 2 Then rng.Interior.ColorIndex = xlNone
    Next
End Sub
 
Юрий М, тогда цвета (Белый, Фон 1) и (Белый, Фон 1, более темный оттенок 5%) макрос не различает
 
Тогда активируйте ячейку с этой заливкой и в окне Immediate выполните строку: ?activecell.Interior.Color

Скопируйте число и вставьте его вместо 16777215 в этот код:
Код
Sub НайтиБелыйЦветЗаливки()
Dim rng As Range
    For Each rng In ActiveSheet.UsedRange.Cells
        If rng.Interior.Color = 16777215 Then rng.Interior.ColorIndex = xlNone
    Next
End Su
 
15921906
 
Юрий М, да, так работает, но хотелось бы перед заменой заливки, посмотреть в каком месте листа будет происходить замена: MsgBox "цвет заливки: (Белый, Фон 1) " & rng.Address(0, 0)
только MsgBox реагирует и на белый цвет и на все остальные ячейки без заливки

?activecell.Interior.Color
16777215 -это Белый, Фон 1
?activecell.Interior.Color
16777215 -а здесь ячейка без заливки
как я уже писал выше, запись макроса показывает такой код при заливке ячейки (Белый, Фон 1)
Код
Sub Макрос1()
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
End Sub
как можно это использовать в макросе? моих знаний не хватает..
и вот тестовый фал
Изменено: sashgera - 27.09.2020 01:21:54
 
Код
Sub НайтиБелыйЦветЗаливки()
Dim rng As Range
For Each rng In ActiveSheet.UsedRange.Cells
    If rng.Interior.ThemeColor = xlThemeColorDark1 And rng.Interior.TintAndShade = 0 Then
        MsgBox "цвет заливки: (Белый, Фон 1) " & rng.Address(0, 0)
        rng.Interior.ThemeColor = xlNone
        MsgBox "цвет заливки: Нет заливки"
    End If
Next rng
End Sub

кажется так работает
Изменено: sashgera - 27.09.2020 01:43:06
 
Код
With Application
    .FindFormat.Clear
    .ReplaceFormat.Clear

    With .FindFormat.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With .ReplaceFormat.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    ActiveSheet.UsedRange.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
    .FindFormat.Clear
    .ReplaceFormat.Clear
End With

Разве что не посмотреть где оно , изменило не получается и захватывает не форматированные ячейки.
Изменено: БМВ - 27.09.2020 09:02:22
По вопросам из тем форума, личку не читаю.
 
Цитата
sashgera написал:
хотелось бы перед заменой заливки, посмотреть в каком месте листа будет происходить замена:
А смысл? Вы же при помощи обычного (по умолчанию) MsgBox не сможете отменить удаление заливки.  Если нужно убрать эту заливку со всех ячеек, то зачем клацать по кнопке 152 раза?  Если же нужно ПРОПУСТИТЬ некоторые ячейки, то в таком случае нужно дать пользователю возможность выбора. Код может быть таким:
Код
Sub НайтиБелыйЦветЗаливки()
Dim rng As Range
    For Each rng In ActiveSheet.UsedRange.Cells
        If rng.Interior.Color = 15921906 Then
            If MsgBox("Искомая заливка найдена в ячейке " & rng.Address(0, 0) & " Удалить заливку?", vbYesNo + 32, "Ваш выбор...") = vbYes Then
                rng.Interior.ColorIndex = xlNone
            End If
        End If
    Next
End Sub
 
Юрий М, понятно, спасибо
Страницы: 1
Наверх