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

Вход

Регистрация

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

 

= Мир MS Excel/Запомнить цвет ячейки - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Запомнить цвет ячейки
Запомнить цвет ячейки
pechkin Дата: Среда, 09.11.2016, 18:18 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 206
Репутация: 27 ±
Замечаний: 0% ±

2003
Здравствуйте! Подскажите пожалуйста, как дополнить макрос, чтобы цвет ячейки до выделения запоминался и после него восстанавливался. Спасибо!
К сообщению приложен файл: 2429026.xls(24Kb)
 
Ответить
СообщениеЗдравствуйте! Подскажите пожалуйста, как дополнить макрос, чтобы цвет ячейки до выделения запоминался и после него восстанавливался. Спасибо!

Автор - pechkin
Дата добавления - 09.11.2016 в 18:18
SLAVICK Дата: Среда, 09.11.2016, 18:38 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 1834
Репутация: 613 ±
Замечаний: 0% ±

2007,2010,2013,2016
Так?
[vba]
Код
Dim curColor&, PreviousColor&, PreviousCell As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Âûäåëåíèå ÿ÷åéêè
If Not PreviousCell Is Nothing Then PreviousCell.Interior.Color = PreviousColor&
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("B:B"), Target) Is Nothing Then
    curColor = Target.Interior.Color
    Target.Interior.ColorIndex = 5
    PreviousColor& = curColor: Set PreviousCell = Target
End If
End Sub
[/vba]
К сообщению приложен файл: 7996230.xls(42Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеТак?
[vba]
Код
Dim curColor&, PreviousColor&, PreviousCell As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Âûäåëåíèå ÿ÷åéêè
If Not PreviousCell Is Nothing Then PreviousCell.Interior.Color = PreviousColor&
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("B:B"), Target) Is Nothing Then
    curColor = Target.Interior.Color
    Target.Interior.ColorIndex = 5
    PreviousColor& = curColor: Set PreviousCell = Target
End If
End Sub
[/vba]

Автор - SLAVICK
Дата добавления - 09.11.2016 в 18:38
pechkin Дата: Среда, 09.11.2016, 18:58 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 206
Репутация: 27 ±
Замечаний: 0% ±

2003
Спасибо! Подскажите почему, если ячейки не имеют обозначенных границ, то после выделения они стираются?
Как в приложенном файле от SLAVICK
К сообщению приложен файл: 7996230-1.xls(38Kb)
 
Ответить
СообщениеСпасибо! Подскажите почему, если ячейки не имеют обозначенных границ, то после выделения они стираются?
Как в приложенном файле от SLAVICK

Автор - pechkin
Дата добавления - 09.11.2016 в 18:58
SLAVICK Дата: Среда, 09.11.2016, 19:05 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 1834
Репутация: 613 ±
Замечаний: 0% ±

2007,2010,2013,2016
Они не стираются - а заливаются белым цветом. Можно так:
[vba]
Код
Dim curColor&, PreviousColor&, PreviousCell As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Выделение ячейки
If Not PreviousCell Is Nothing Then If PreviousColor& = "16777215" Then PreviousCell.Interior.Pattern = xlNone Else PreviousCell.Interior.Color = PreviousColor&
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("B:B"), Target) Is Nothing Then
    curColor = Target.Interior.Color
    Target.Interior.ColorIndex = 5
    PreviousColor& = curColor: Set PreviousCell = Target
End If
End Sub
[/vba]
К сообщению приложен файл: 9157217.xls(40Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеОни не стираются - а заливаются белым цветом. Можно так:
[vba]
Код
Dim curColor&, PreviousColor&, PreviousCell As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Выделение ячейки
If Not PreviousCell Is Nothing Then If PreviousColor& = "16777215" Then PreviousCell.Interior.Pattern = xlNone Else PreviousCell.Interior.Color = PreviousColor&
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("B:B"), Target) Is Nothing Then
    curColor = Target.Interior.Color
    Target.Interior.ColorIndex = 5
    PreviousColor& = curColor: Set PreviousCell = Target
End If
End Sub
[/vba]

Автор - SLAVICK
Дата добавления - 09.11.2016 в 19:05
Udik Дата: Среда, 09.11.2016, 19:11 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 1202
Репутация: 152 ±
Замечаний: 0% ±

Excel 2013
Или вариация
[vba]
Код

Dim bufColor As Long
Dim bufAdr As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Выделение ячейки
Dim rng1 As Range
If bufAdr <> "" Then Range(bufAdr).Interior.Color = bufColor
If Target.Count > 1 Then Exit Sub
If Target.Column <> 2 Then Exit Sub

bufAdr = Target.Address
bufColor = Target.Interior.Color
Target.Interior.ColorIndex = 5
End Sub

[/vba]
К сообщению приложен файл: 0t.xls(37Kb)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
СообщениеИли вариация
[vba]
Код

Dim bufColor As Long
Dim bufAdr As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Выделение ячейки
Dim rng1 As Range
If bufAdr <> "" Then Range(bufAdr).Interior.Color = bufColor
If Target.Count > 1 Then Exit Sub
If Target.Column <> 2 Then Exit Sub

bufAdr = Target.Address
bufColor = Target.Interior.Color
Target.Interior.ColorIndex = 5
End Sub

[/vba]

Автор - Udik
Дата добавления - 09.11.2016 в 19:11
pechkin Дата: Среда, 09.11.2016, 19:30 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 206
Репутация: 27 ±
Замечаний: 0% ±

2003
Еще раз СПАСИБО всем! hands Udik, в Вашем файле ячейки тоже заливаются белым
 
Ответить
СообщениеЕще раз СПАСИБО всем! hands Udik, в Вашем файле ячейки тоже заливаются белым

Автор - pechkin
Дата добавления - 09.11.2016 в 19:30
Udik Дата: Среда, 09.11.2016, 19:55 | Сообщение № 7
Группа: Друзья
Ранг: Старожил
Сообщений: 1202
Репутация: 152 ±
Замечаний: 0% ±

Excel 2013
ячейки тоже заливаются белым

Дык, тоже самое что и SLAVICK, добавляем
[vba]
Код

Dim bufColor As Long
Dim bufAdr As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Выделение ячейки
Dim rng1 As Range
If bufAdr <> "" Then
If bufColor = "16777215" Then
Range(bufAdr).Interior.Pattern = xlNone
Else
Range(bufAdr).Interior.Color = bufColor
End If
End If
If Target.Count > 1 Then Exit Sub
If Target.Column <> 2 Then Exit Sub

bufAdr = Target.Address
bufColor = Target.Interior.Color
Target.Interior.ColorIndex = 5
End Sub

[/vba]


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
Сообщение
ячейки тоже заливаются белым

Дык, тоже самое что и SLAVICK, добавляем
[vba]
Код

Dim bufColor As Long
Dim bufAdr As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Выделение ячейки
Dim rng1 As Range
If bufAdr <> "" Then
If bufColor = "16777215" Then
Range(bufAdr).Interior.Pattern = xlNone
Else
Range(bufAdr).Interior.Color = bufColor
End If
End If
If Target.Count > 1 Then Exit Sub
If Target.Column <> 2 Then Exit Sub

bufAdr = Target.Address
bufColor = Target.Interior.Color
Target.Interior.ColorIndex = 5
End Sub

[/vba]

Автор - Udik
Дата добавления - 09.11.2016 в 19:55
_Boroda_ Дата: Среда, 09.11.2016, 23:56 | Сообщение № 8
Группа: Модераторы
Ранг: Экселист
Сообщений: 9347
Репутация: 3922 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Еще такой вариант условным форматированием
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Column <> 2 Then Exit Sub
    On Error Resume Next
    Columns("B:B").FormatConditions(1).Delete
'Columns("B:B").FormatConditions.Delete 'Для 2003
    Target.FormatConditions.Add Type:=xlExpression, Formula1:="=1"
    Target.FormatConditions(1).Interior.ColorIndex = 5
End Sub
[/vba]
Если нужно для 2003 Excel, то там аналогично, но
К сообщению приложен файл: 2429026_1.xls(34Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЕще такой вариант условным форматированием
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Column <> 2 Then Exit Sub
    On Error Resume Next
    Columns("B:B").FormatConditions(1).Delete
'Columns("B:B").FormatConditions.Delete 'Для 2003
    Target.FormatConditions.Add Type:=xlExpression, Formula1:="=1"
    Target.FormatConditions(1).Interior.ColorIndex = 5
End Sub
[/vba]
Если нужно для 2003 Excel, то там аналогично, но

Автор - _Boroda_
Дата добавления - 09.11.2016 в 23:56
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Запомнить цвет ячейки
Страница 1 из 11
Поиск:

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