Макросы в Excel VBA Макросы Цвет и границы диапазона

Цвет и границы диапазона

Изменяем цвет фона, цвет и размер шрифта

'Заливаем область цветом и меняем размер/цвет шрифта
'[i1, j1] - координаты верхней левой ячейки диапазона
'[i2, j2] - координаты нижней правой ячейки диапазона
'(если =0, то диапазон состоит только из ячейки [i1, j1])
'InteriorColor - цвет фона (если 0 то убираем заливку)
'FontColor, FontSize - цвет и размер шрифта
'(если не указаны, то шрифт не изменяется)
Public Sub FillRange(Optional i1 As Long = 0, _
 Optional j1 As Long = 0, _
 Optional i2 As Long = 0, _
 Optional j2 As Long = 0, _
 Optional InteriorColor As Long = 0, _
 Optional FontColor As Long = 0, _
 Optional FontSize As Long = 0)
                    
 i1 = Abs(i1): j1 = Abs(j1): i2 = Abs(i2): j2 = Abs(j2)
 If (i1 > 0 Or j1 > 0) And (i2 >= 0 And j2 >= 0) Then
        
  If i1 = 0 Then i1 = 1
  If j1 = 0 Then j1 = 1
  If i2 = 0 Then i2 = i1
  If j2 = 0 Then j2 = j1
        
  With .Range(.Cells(i1, j1), .Cells(i2, j2))
   With .Interior
    If InteriorColor <> 0 Then
     .Color = InteriorColor
    Else
     .Pattern = xlNone
    End If
   End With

   If FontColor <> 0 Then .Font.Color = FontColor
   If FontSize <> 0 Then .Font.Size = FontSize
   
  End With
    
 End If

End Sub

Изменяем наличие и толщину границ диапазона

'Граница диапазона
'[i1, j1] - координаты верхней левой ячейки диапазона
'[i2, j2] - координаты нижней правой ячейки диапазона
'(если =0, то диапазон состоит только из ячейки [i1, j1])
'Clr - цвет границы, по умолчанию чёрный
'Weight: [xlThin, xlThick, 0] - рамка
'потоньше (по умолчанию), потолще
'или очистить границу (если =0)
'ClrInside - цвет внутренних тонких границ
'(если = 0, то будет только внешняя граница диапазона 
'ClearOldBorder: [True, False] - очищать ли
'предыдущую границу (по умолчанию - Да)
Public Sub Border(Optional i1 As Long = 0, _
 Optional j1 As Long = 0, _
 Optional i2 As Long = 0, _
 Optional j2 As Long = 0, _
 Optional Clr As Long = -16777216, _
 Optional Weight As Long = xlThin, _
 Optional ClrInside As Long = -16777216, _
 Optional ClearOldBorder As Boolean = True)
    
 i1 = Abs(i1): j1 = Abs(j1): i2 = Abs(i2): j2 = Abs(j2)
 If i1 > 0 And j1 > 0 And i2 >= 0 And j2 >= 0 Then

 'Последняя ячейка находится на той же строке что и первая
 If i2 = 0 Then i2 = i1 
 'Последняя ячейка находится в том же столбце что и первая
 If j2 = 0 Then j2 = j1 
        
  'В пределах указанного диапазона		
  With .Range(Cells(i1, j1), Cells(i2, j2)) 
            
   If Clr = 0 Then 'Просто очистить от старых границ и всё

    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone

   Else 'Граница перекрашивается в другой цвет
            
    If ClearOldBorder Then 'Очищаем от старой границы?
     .Borders(xlDiagonalDown).LineStyle = xlNone
     .Borders(xlDiagonalUp).LineStyle = xlNone
     .Borders(xlEdgeLeft).LineStyle = xlNone
     .Borders(xlEdgeTop).LineStyle = xlNone
     .Borders(xlEdgeBottom).LineStyle = xlNone
     .Borders(xlEdgeRight).LineStyle = xlNone
     .Borders(xlInsideVertical).LineStyle = xlNone
     .Borders(xlInsideHorizontal).LineStyle = xlNone
    End If
                    
    If Weight = 0 Then
     .Borders(xlDiagonalDown).LineStyle = xlNone
     .Borders(xlDiagonalUp).LineStyle = xlNone
     .Borders(xlEdgeLeft).LineStyle = xlNone
     .Borders(xlEdgeTop).LineStyle = xlNone
     .Borders(xlEdgeBottom).LineStyle = xlNone
     .Borders(xlEdgeRight).LineStyle = xlNone
     .Borders(xlInsideVertical).LineStyle = xlNone
     .Borders(xlInsideHorizontal).LineStyle = xlNone
    Else
                    
     'Внутренние тонкие границы
     If ClrInside <> 0 Then
      With .Borders(xlInsideVertical)
       .LineStyle = xlContinuous
       .ColorIndex = 0
       .Color = ClrInside
       .TintAndShade = 0
       .Weight = xlThin
      End With
      With .Borders(xlInsideHorizontal)
       .LineStyle = xlContinuous
       .ColorIndex = 0
       .Color = ClrInside
       .TintAndShade = 0
       .Weight = xlThin
      End With
     End If
                    
     'Слева, сверху, снизу, справа
     With .Borders(xlEdgeLeft)
      .LineStyle = xlContinuous
      .ColorIndex = 0
      .Color = Clr
      .TintAndShade = 0
      .Weight = Weight
     End With
     With .Borders(xlEdgeTop)
      .LineStyle = xlContinuous
      .ColorIndex = 0
      .Color = Clr
      .TintAndShade = 0
      .Weight = Weight
     End With
     With .Borders(xlEdgeBottom)
      .LineStyle = xlContinuous
      .ColorIndex = 0
      .Color = Clr
      .TintAndShade = 0
      .Weight = Weight
     End With
     With .Borders(xlEdgeRight)
      .LineStyle = xlContinuous
      .ColorIndex = 0
      .Color = Clr
      .TintAndShade = 0
      .Weight = Weight
     End With
    
    End If
                
   End If

  End With
    
 End If
 
End Sub