Подсветка активной строки в Excel

Зачастую при вводе данных в большие таблицы возникает необходимость точно видеть активную ячейку, а также данные в текущей строке или столбце. Excel, конечно делает шаг навстречу пользователю, подсвечивая заголовок строки и столбца, но это не спасает. Итак, нам нужна яркая подсветка активной строки и столбца, чтобы их было легче обнаружить.

Так начиналась одна из первых статей этого блога. Судя по тому, что каждый год она стабильно оказывалась в десятке самых популярных, тема дополнительной подсветки строк и столбцов в Excel была и остается актуальной и востребованной.

Тогда, в 2012 году, я предложил читателям способ выделения активной строки и столбца цветной заливкой с помощью макроса VBA. Этот способ, хоть и решал проблему четкого определения текущей позиции на листе, тем не менее был далек от идеала. К его недостаткам стоит отнести следующее:

  • Программный код изменял существующую заливку на листе. Если какие-то ячейки были по той или иной причине выделены цветом, то это форматирование терялось, как только срабатывал макрос подсветки.
  • Excel не позволяет отменять действие макроса с помощью сочетания клавиш CTRL + Z. После щелчка по любой ячейке вернуть предыдущий вариант заливки было невозможно.

К счастью, технологии не стоят на месте, и сегодня я обнаружил в комментариях к этой статье отличный способ выделять активную строку и столбец, не нарушая оформления ячеек на рабочем листе.

Новый метод подсветки активной строки и столбца

Все гениальное, как всегда, просто. Суть метода в том, что для выделения активной строки и/или столбца используются объекты с определенным названием. В моем примере - это жирные красные линии с именами "МаркерСтроки" и "МаркерСтолбца". Поскольку эти объекты никак не взаимодействуют с содержимым рабочего листа (они просто наложены поверх ячеек), то и никаких необратимых изменений в рабочий лист не вносится. Удалить эти линии можно в любой момент, так что все недостатки предыдущего метода сводятся на нет.

Каким же образом реализовать подобное выделение строк и столбцов? Самое "сердце" метода - это следующая небольшая процедура, расположенная в модуле рабочей книги.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    'LINE MARKER
   
    ' Выделение строки осуществляем, если в ячейке А1 есть значение и оно больше нуля
    If [A1].Value > 0 Then
        With Sh
            ' Изменяем положение линии, выделяющей строку
            .Shapes("МаркерСтроки").Top = ActiveCell.Offset(1, 0).Top
            .Shapes("МаркерСтроки").Left = ActiveWindow.VisibleRange.Left
            .Shapes("МаркерСтроки").Width = ActiveWindow.VisibleRange.Cells(1, ActiveWindow.VisibleRange.Columns.Count).Left - ActiveWindow.VisibleRange.Left
        End With
    End If
End Sub

Использование этой процедуры подразумевает, что объект "Линия" уже создан и ему присвоено имя "МаркерСтроки"

Я же говорил, что гениальное - просто!

Дальнейшее усовершенствование

Ну что же, суть решения понятна, но оно пока годится только для "домашнего" использования, потому что требует ряда дополнительных действий: создания линии, присвоения ей заранее определенного имени, и т.п. Если что-то упустить, то метод не сработает. Так что я немного доработал процедуру: добавил отображение вертикальной линии, удаление обеих линий при удалении значения в ячейке A1, а также написал подобие "интеллектуального" определения длины линий - в структурированных таблицах линии распространяются на все столбцы и строки таблицы, а вне таблиц - только на видимый диапазон.

Весь программный код сосредоточен в модуле рабочей книги, чтобы включить его в свои проекты, следуйте этой инструкции.

А вот и полный код решения:

Private Const ROW_MARKER As String = "МаркерСтроки"     ' имя для линии, подчеркивающей строку
Private Const COLUMN_MARKER As String = "МаркерСтолбца" ' имя для линии, выделяющей столбец

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Процедура, срабатывающая при изменении выделенной ячейки на
' любом листе рабочей книги.
'
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
    ' Выбор границ диапазона для рисования линий
    Dim MarkerRange As Range
    Set MarkerRange = ChooseMarkerRange(Target)
   
    If [A1].Value > 0 Then
        ' Показываем линии, только если в ячейке А1 на листе есть значение
        ' и оно больше нуля
        ShowMarkerLines MarkerRange
    Else
        ' Если А1 - пустая или содержит 0, тогда удаляем наши линии
        HideMarkerLines
    End If
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Удаление маркерных линий
'
Private Sub HideMarkerLines()
    Dim sh As Shape
    
    ' Если название объекта "Фигура" на рабочем листе совпадает с
    ' определенными для маркерных линий именами, то удаляем такой
    ' объект
    For Each sh In ActiveSheet.Shapes
        If sh.Name = ROW_MARKER Or sh.Name = COLUMN_MARKER Then
            sh.Delete
        End If
    Next
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Настройка отображения маркерных линий
'
Private Sub ShowMarkerLines(ByVal rng As Range)
    ' Создаем маркер строки, если его нет на листе
    If ThereIsNoLineMarker(ROW_MARKER) Then
        CreateMarkerLine ROW_MARKER
    End If
    ' Настраиваем маркер строки
    With ActiveSheet.Shapes(ROW_MARKER)
        .Top = ActiveCell.Offset(1, 0).Top
        .Left = rng.Left
        .Width = rng.Cells(1, rng.Columns.Count + 1).Left - rng.Left
    End With
    
    ' Создаем маркер столбца, если его нет на листе
    If ThereIsNoLineMarker(COLUMN_MARKER) Then
        CreateMarkerLine COLUMN_MARKER
    End If
    ' Настраиваем маркер столбца
    With ActiveSheet.Shapes(COLUMN_MARKER)
        .Top = rng.Top
        .Left = ActiveCell.Left
        .Height = rng.Cells(rng.Rows.Count + 1, 1).Top - rng.Top
    End With
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Создание маркерных линий, присвоение им определенных имен
'
Private Sub CreateMarkerLine(ByVal markerName As String)
    Dim line As Shape
    Set line = ActiveSheet.Shapes.AddLine(1, 1, 1, 1)
    line.ShapeStyle = msoLineStylePreset10
    line.Name = markerName
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Вспомогательная процедура для определения того, создана ли
' уже маркерная линия с указанным именем
'
Private Function ThereIsNoLineMarker(ByVal markerName As String) As Boolean
    Dim sh As Shape
    Dim result As Boolean
    result = True
    
    For Each sh In ActiveSheet.Shapes
        If sh.Name = markerName Then
            result = False
            Exit For
        End If
    Next
    
    ThereIsNoLineMarker = result
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Выбор диапазона, в котором будут отображаться маркерные линии
'
Private Function ChooseMarkerRange(ByVal Target As Range) As Range
    Dim result As Range
    
    If Not (Target.ListObject Is Nothing) Then
        ' Если выделенная ячейка находится в структурированной
        ' таблице, то подчеркиваем строки и столбцы только в
        ' пределах этой таблицы
        Set result = Target.ListObject.Range
    ElseIf Target.CurrentRegion.Cells.Count > 1 Then
        ' Если выделенная ячейка находится вне таблицы, но в
        ' некотором заполненном диапазоне ячеек, то подчеркиваем
        ' строки и столбцы только в этом диапазоне
        Set result = Target.CurrentRegion
    Else
        ' Во всех остальных случаях подчеркиваем строки и
        ' столбцы только в рамках видимого диапазона
        Set result = ActiveWindow.VisibleRange
    End If

    Set ChooseMarkerRange = result
End Function