Границы Таблицы

[Busine2009]

Как оптимизировать код.
Задача: если ячейка имеет границы (ну в смысле при распечатки распечатываются границы), то изменить эту границу на другую.
Проблема: загрузка процессора на 100% (Celeron 2 ГГб) и медленная работа макроса с небольшими таблицами (на полстраницы) около 10 минут работает.

Код: Выделить всё

Sub ТаблицаГрафики()
Dim oCell As Cell
For Each oCell In Selection.Tables(1).Range.Cells
If oCell.Borders(wdBorderTop) = True Then
    oCell.Borders(wdBorderTop).Color = wdColorDarkBlue
    oCell.Borders(wdBorderTop).LineStyle = wdLineStyleSingle
    oCell.Borders(wdBorderTop).LineWidth = wdLineWidth075pt
End If
If oCell.Borders(wdBorderBottom) = True Then
    oCell.Borders(wdBorderBottom).Color = wdColorDarkBlue
    oCell.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
    oCell.Borders(wdBorderBottom).LineWidth = wdLineWidth075pt
End If
If oCell.Borders(wdBorderLeft) = True Then
    oCell.Borders(wdBorderLeft).Color = wdColorDarkBlue
    oCell.Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
    oCell.Borders(wdBorderLeft).LineWidth = wdLineWidth075pt
End If
If oCell.Borders(wdBorderRight) = True Then
    oCell.Borders(wdBorderRight).Color = wdColorDarkBlue
    oCell.Borders(wdBorderRight).LineStyle = wdLineStyleSingle
    oCell.Borders(wdBorderRight).LineWidth = wdLineWidth075pt
End If
Next
With Selection.Tables(1)
    With .Borders(wdBorderLeft)
        .LineStyle = wdLineStyleDouble
        .LineWidth = wdLineWidth075pt
        .Color = wdColorAutomatic
    End With
    With .Borders(wdBorderRight)
        .LineStyle = wdLineStyleDouble
        .LineWidth = wdLineWidth075pt
        .Color = wdColorAutomatic
    End With
    With .Borders(wdBorderTop)
        .LineStyle = wdLineStyleDouble
        .LineWidth = wdLineWidth075pt
        .Color = wdColorAutomatic
    End With
    With .Borders(wdBorderBottom)
        .LineStyle = wdLineStyleDouble
        .LineWidth = wdLineWidth075pt
        .Color = wdColorDarkBlue
    End With
End With
End Sub