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

Вход

Регистрация

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

 

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

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Запомнить цвет ячейки
Запомнить цвет ячейки
pechkin Дата: Среда, 09.11.2016, 18:18 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 332
Репутация: 49 ±
Замечаний: 0% ±

2003
Здравствуйте! Подскажите пожалуйста, как дополнить макрос, чтобы цвет ячейки до выделения запоминался и после него восстанавливался. Спасибо!
К сообщению приложен файл: 2429026.xls (23.5 Kb)
 
Ответить
СообщениеЗдравствуйте! Подскажите пожалуйста, как дополнить макрос, чтобы цвет ячейки до выделения запоминался и после него восстанавливался. Спасибо!
Автор - pechkin
Дата добавления - 09.11.2016 в 18:18
SLAVICK Дата: Среда, 09.11.2016, 18:38 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Так?
[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 (42.5 Kb)

Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеТак?
[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
Группа: Проверенные
Ранг: Обитатель
Сообщений: 332
Репутация: 49 ±
Замечаний: 0% ±

2003
Спасибо! Подскажите почему, если ячейки не имеют обозначенных границ, то после выделения они стираются?
Как в приложенном файле от SLAVICK
К сообщению приложен файл: 7996230-1.xls (38.5 Kb)
 
Ответить
СообщениеСпасибо! Подскажите почему, если ячейки не имеют обозначенных границ, то после выделения они стираются?
Как в приложенном файле от SLAVICK
Автор - pechkin
Дата добавления - 09.11.2016 в 18:58
SLAVICK Дата: Среда, 09.11.2016, 19:05 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Они не стираются - а заливаются белым цветом. Можно так:
[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 (40.5 Kb)

Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеОни не стираются - а заливаются белым цветом. Можно так:
[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
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
Или вариация
[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 (37.0 Kb)

вот вам барабан
яд 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
Группа: Проверенные
Ранг: Обитатель
Сообщений: 332
Репутация: 49 ±
Замечаний: 0% ±

2003
Еще раз СПАСИБО всем! hands Udik, в Вашем файле ячейки тоже заливаются белым
 
Ответить
СообщениеЕще раз СПАСИБО всем! hands Udik, в Вашем файле ячейки тоже заливаются белым
Автор - pechkin
Дата добавления - 09.11.2016 в 19:30
Udik Дата: Среда, 09.11.2016, 19:55 | Сообщение № 7
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
Цитата pechkin, 09.11.2016 в 19:30, в сообщении № 6
ячейки тоже заливаются белым

Дык, тоже самое что и 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
 
Ответить
Сообщение
Цитата pechkin, 09.11.2016 в 19:30, в сообщении № 6
ячейки тоже заливаются белым

Дык, тоже самое что и 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
Группа: Админы
Ранг: Местный житель
Сообщений: 16901
Репутация: 6613 ±
Замечаний: ±

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 (34.5 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
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 из 1
  • 1
Поиск:

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