Добрый вечер, знатоки макросов! Подскажите пожалуйста, что нужно добавить в существующий макрос, чтобы было не просто выделение активных строки/столбца, а выделение цветом?
код макроса выделения такой: [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]
Добрый вечер, знатоки макросов! Подскажите пожалуйста, что нужно добавить в существующий макрос, чтобы было не просто выделение активных строки/столбца, а выделение цветом?
код макроса выделения такой: [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
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
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]
Но как сделать в этом коде, чтобы он постоянно был включен на листе, без кнопки ДОБАВИТЬ ВЫДЕЛЕНИЕ или вызова макроса на включение.
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
Vadym Gorokh
Сообщение отредактировал grh1 - Суббота, 21.09.2019, 08:16
Приветствую gling - надо без УФ. Н. Павлова макрос очень устраивает - он не убивает форматирование на листе, но как сделать, чтобы макрос всегда был включен - не знаю. При открытии книги, приходится заново запускать макрос.
Приветствую gling - надо без УФ. Н. Павлова макрос очень устраивает - он не убивает форматирование на листе, но как сделать, чтобы макрос всегда был включен - не знаю. При открытии книги, приходится заново запускать макрос.grh1
Да, конечно. Код на выделение активной строки/столбца Н. Павлова, убрано вкл/выкл макроса - работает постоянно [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]
Код
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