Excel VBA Макросы: Как сделать (нарисовать) границу у ячейки, если границы нет.

[Fluffy]

Есть таблица на листе. У некоторых ячеек уже есть границы разной толщины. Причем, у одной ячейки может быть одна тонкая граница, другая толстая, а остальных нет.

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

Как я понимаю - макрос должен проверять каждую ячейку на наличие каждой границы и где той нет - рисовать. Диагональные границы не нужны.

[Администратор]

Макрос обрабатывает ячейки выделенного фрагмента.

Макрос

Sub Макрос()
   
    Dim rng As Range, ячейка As Range
    Dim i As Long
   
   
    ' Отключаем монитор, чтобы ускорить макрос.
    Application.ScreenUpdating = False
   
    '1. Присваиваем выделенному фрагменту имя "rng".
        ' Может это упростит написание кода.
    Set rng = Selection
   
    '2. Если у выделенных ячеек нет границ, то делаем границы сразу у всех ячеек.
    If rng.Borders.LineStyle = xlLineStyleNone Then
        rng.Borders.LineStyle = 1
        rng.Borders.Weight = 1
        Exit Sub
    End If
   
    '3. Двигаемся по всем ячейкам выделенного фрагмента.
    For Each ячейка In rng.Cells
   
        '1) Если у ячейки нет ни одной границы.
        If ячейка.Borders.LineStyle = xlLineStyleNone Then
            ' Делаем сразу все границы у ячейки.
            ячейка.Borders.LineStyle = 1
            ячейка.Borders.Weight = 1
        '2) Если у ячейки есть границы.
        Else
            ' Двигаемся по четырём границам ячейки: лево, верх, низ, право.
            For i = 7 To 10
                If ячейка.Borders(i).LineStyle = -4142 Then
                    ячейка.Borders(i).LineStyle = 1
                    ячейка.Borders(i).Weight = 1
                End If
            Next i
        End If
           
    Next ячейка
   
End Sub

[свернуть]

[Fluffy]

Спасибо огромное!!! Все работает!!!