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

Вход

Регистрация

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

 

= Мир MS Excel/выделение активной строки цветом - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » выделение активной строки цветом (Макросы/Sub)
выделение активной строки цветом
grh1 Дата: Пятница, 20.09.2019, 19:10 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
Добрый вечер, знатоки макросов!
Подскажите пожалуйста, что нужно добавить в существующий макрос, чтобы было не просто выделение активных строки/столбца, а выделение цветом?

код макроса выделения такой:
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WorkRange As Range

    If Target.Cells.Count > 1 Then Exit Sub  'если выделено больше 1 ячейки - выходим
     
    Application.ScreenUpdating = False
    Set WorkRange = Range("A11:BX7300")    'адрес рабочего диапазона, в пределах которого видно выделение
    Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select  'формируем крестообразный диапазон и выделяем
    Target.Activate
        
End Sub

[/vba]


Vadym Gorokh

Сообщение отредактировал grh1 - Пятница, 20.09.2019, 19:15
 
Ответить
СообщениеДобрый вечер, знатоки макросов!
Подскажите пожалуйста, что нужно добавить в существующий макрос, чтобы было не просто выделение активных строки/столбца, а выделение цветом?

код макроса выделения такой:
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WorkRange As Range

    If Target.Cells.Count > 1 Then Exit Sub  'если выделено больше 1 ячейки - выходим
     
    Application.ScreenUpdating = False
    Set WorkRange = Range("A11:BX7300")    'адрес рабочего диапазона, в пределах которого видно выделение
    Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select  'формируем крестообразный диапазон и выделяем
    Target.Activate
        
End Sub

[/vba]

Автор - grh1
Дата добавления - 20.09.2019 в 19:10
Kuzmich Дата: Пятница, 20.09.2019, 22:35 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WorkRange As Range
    If Target.Cells.Count > 1 Then Exit Sub  'если выделено больше 1 ячейки - выходим
       Application.ScreenUpdating = False
    Set WorkRange = Range("A11:BX7300")    'адрес рабочего диапазона, в пределах которого видно выделение
          WorkRange.Interior.ColorIndex = xlColorIndexNone
    Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select  'формируем крестообразный диапазон и выделяем
         Selection.Interior.ColorIndex = 6
    Target.Activate
End Sub
[/vba]
 
Ответить
Сообщение[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WorkRange As Range
    If Target.Cells.Count > 1 Then Exit Sub  'если выделено больше 1 ячейки - выходим
       Application.ScreenUpdating = False
    Set WorkRange = Range("A11:BX7300")    'адрес рабочего диапазона, в пределах которого видно выделение
          WorkRange.Interior.ColorIndex = xlColorIndexNone
    Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select  'формируем крестообразный диапазон и выделяем
         Selection.Interior.ColorIndex = 6
    Target.Activate
End Sub
[/vba]

Автор - Kuzmich
Дата добавления - 20.09.2019 в 22:35
grh1 Дата: Суббота, 21.09.2019, 08:05 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
Kuzmich, спасибо, но немного не то... Так я тоже делал, но цвет накладывается на выделение и получается искажение цвета - хочу желтый, получаю грязно-оранжевый.

Вот код Н. Павлова, который:
1. не убивает ранее установленное цветовое форматирование на листе;
2. цвет выделения активной строки/столбца является оригинальным.
(выставил светло-зеленый цвет, он и выделяет этим цветом)


[vba]
Код
Dim Coord_Selection As Boolean
Sub Selection_On()
    Coord_Selection = True
End Sub
Sub Selection_Off()
    Coord_Selection = False
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WorkRange As Range, CrossRange As Range
    Set WorkRange = Range("A11:CC7300")
    If Target.Count > 1 Then Exit Sub
    If Coord_Selection = False Then
        WorkRange.FormatConditions.Delete
        Exit Sub
    End If
    Application.ScreenUpdating = False
    If Not Intersect(Target, WorkRange) Is Nothing Then
        Set CrossRange = Intersect(WorkRange, Target.EntireRow) 'это окрас строк+столбец Set CrossRange = Intersect(WorkRange, Union(Target.EntireRow, Target.EntireColumn))
        WorkRange.FormatConditions.Delete
        CrossRange.FormatConditions.Add Type:=xlExpression, Formula1:="=1"
        CrossRange.FormatConditions(1).Interior.ColorIndex = 35
        Target.FormatConditions.Delete
    End If
End Sub
[/vba]

Но как сделать в этом коде, чтобы он постоянно был включен на листе, без кнопки ДОБАВИТЬ ВЫДЕЛЕНИЕ или вызова макроса на включение.


Vadym Gorokh

Сообщение отредактировал grh1 - Суббота, 21.09.2019, 08:16
 
Ответить
СообщениеKuzmich, спасибо, но немного не то... Так я тоже делал, но цвет накладывается на выделение и получается искажение цвета - хочу желтый, получаю грязно-оранжевый.

Вот код Н. Павлова, который:
1. не убивает ранее установленное цветовое форматирование на листе;
2. цвет выделения активной строки/столбца является оригинальным.
(выставил светло-зеленый цвет, он и выделяет этим цветом)


[vba]
Код
Dim Coord_Selection As Boolean
Sub Selection_On()
    Coord_Selection = True
End Sub
Sub Selection_Off()
    Coord_Selection = False
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WorkRange As Range, CrossRange As Range
    Set WorkRange = Range("A11:CC7300")
    If Target.Count > 1 Then Exit Sub
    If Coord_Selection = False Then
        WorkRange.FormatConditions.Delete
        Exit Sub
    End If
    Application.ScreenUpdating = False
    If Not Intersect(Target, WorkRange) Is Nothing Then
        Set CrossRange = Intersect(WorkRange, Target.EntireRow) 'это окрас строк+столбец Set CrossRange = Intersect(WorkRange, Union(Target.EntireRow, Target.EntireColumn))
        WorkRange.FormatConditions.Delete
        CrossRange.FormatConditions.Add Type:=xlExpression, Formula1:="=1"
        CrossRange.FormatConditions(1).Interior.ColorIndex = 35
        Target.FormatConditions.Delete
    End If
End Sub
[/vba]

Но как сделать в этом коде, чтобы он постоянно был включен на листе, без кнопки ДОБАВИТЬ ВЫДЕЛЕНИЕ или вызова макроса на включение.

Автор - grh1
Дата добавления - 21.09.2019 в 08:05
gling Дата: Суббота, 21.09.2019, 08:32 | Сообщение № 4
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2519
Репутация: 674 ±
Замечаний: 0% ±

2010
Здравствуйте. А такой вариант не подходит?


ЯД-41001506838083
 
Ответить
СообщениеЗдравствуйте. А такой вариант не подходит?

Автор - gling
Дата добавления - 21.09.2019 в 08:32
grh1 Дата: Суббота, 21.09.2019, 09:22 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
Приветствую gling - надо без УФ.
Н. Павлова макрос очень устраивает - он не убивает форматирование на листе, но как сделать, чтобы макрос всегда был включен - не знаю. При открытии книги, приходится заново запускать макрос.


Vadym Gorokh
 
Ответить
СообщениеПриветствую gling - надо без УФ.
Н. Павлова макрос очень устраивает - он не убивает форматирование на листе, но как сделать, чтобы макрос всегда был включен - не знаю. При открытии книги, приходится заново запускать макрос.

Автор - grh1
Дата добавления - 21.09.2019 в 09:22
Kuzmich Дата: Суббота, 21.09.2019, 09:41 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Цитата
но цвет накладывается на выделение и получается искажение цвета

Замените строку
[vba]
Код
Target.Activate
[/vba]
на
[vba]
Код
Target.Select
[/vba]
 
Ответить
Сообщение
Цитата
но цвет накладывается на выделение и получается искажение цвета

Замените строку
[vba]
Код
Target.Activate
[/vba]
на
[vba]
Код
Target.Select
[/vba]

Автор - Kuzmich
Дата добавления - 21.09.2019 в 09:41
grh1 Дата: Суббота, 21.09.2019, 10:03 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
Замените строку
Target.Activate

на
Target.Select

После этой замены excel зависает намертво...


Vadym Gorokh

Сообщение отредактировал grh1 - Суббота, 21.09.2019, 10:03
 
Ответить
Сообщение
Замените строку
Target.Activate

на
Target.Select

После этой замены excel зависает намертво...

Автор - grh1
Дата добавления - 21.09.2019 в 10:03
grh1 Дата: Суббота, 21.09.2019, 10:24 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
Всем спасибо за участие, разобрался с кодом Н. Павлова.
Тему закрываем.


Vadym Gorokh
 
Ответить
СообщениеВсем спасибо за участие, разобрался с кодом Н. Павлова.
Тему закрываем.

Автор - grh1
Дата добавления - 21.09.2019 в 10:24
Pelena Дата: Суббота, 21.09.2019, 11:35 | Сообщение № 9
Группа: Админы
Ранг: Местный житель
Сообщений: 19163
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
разобрался

не хотите поделиться решением?


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
разобрался

не хотите поделиться решением?

Автор - Pelena
Дата добавления - 21.09.2019 в 11:35
grh1 Дата: Суббота, 21.09.2019, 12:47 | Сообщение № 10
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
не хотите поделиться решением?


Да, конечно.
Код на выделение активной строки/столбца Н. Павлова, убрано вкл/выкл макроса - работает постоянно
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WorkRange As Range, CrossRange As Range
    Set WorkRange = Range("A11:CC7300")
    If Target.Count > 1 Then Exit Sub

    Application.ScreenUpdating = False
    If Not Intersect(Target, WorkRange) Is Nothing Then
        Set CrossRange = Intersect(WorkRange, Target.EntireRow) 'это окрас строк+столбец Set CrossRange = Intersect(WorkRange, Union(Target.EntireRow, Target.EntireColumn))
        WorkRange.FormatConditions.Delete 'эта строка делает так, чтобы выделение не оставалось
        CrossRange.FormatConditions.Add Type:=xlExpression, Formula1:="=1"
        CrossRange.FormatConditions(1).Interior.ColorIndex = 35
        Target.FormatConditions.Delete 'эта строка убирает заливку в активной ЯЧЕЙКЕ (она становится белой)
    End If
End Sub
[/vba]

Не убивает форматирование на листе


Vadym Gorokh

Сообщение отредактировал grh1 - Суббота, 21.09.2019, 12:48
 
Ответить
Сообщение
не хотите поделиться решением?


Да, конечно.
Код на выделение активной строки/столбца Н. Павлова, убрано вкл/выкл макроса - работает постоянно
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WorkRange As Range, CrossRange As Range
    Set WorkRange = Range("A11:CC7300")
    If Target.Count > 1 Then Exit Sub

    Application.ScreenUpdating = False
    If Not Intersect(Target, WorkRange) Is Nothing Then
        Set CrossRange = Intersect(WorkRange, Target.EntireRow) 'это окрас строк+столбец Set CrossRange = Intersect(WorkRange, Union(Target.EntireRow, Target.EntireColumn))
        WorkRange.FormatConditions.Delete 'эта строка делает так, чтобы выделение не оставалось
        CrossRange.FormatConditions.Add Type:=xlExpression, Formula1:="=1"
        CrossRange.FormatConditions(1).Interior.ColorIndex = 35
        Target.FormatConditions.Delete 'эта строка убирает заливку в активной ЯЧЕЙКЕ (она становится белой)
    End If
End Sub
[/vba]

Не убивает форматирование на листе

Автор - grh1
Дата добавления - 21.09.2019 в 12:47
Мир MS Excel » Вопросы и решения » Вопросы по VBA » выделение активной строки цветом (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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