Untitled
unknown
plain_text
12 days ago
2.3 kB
2
Indexable
Never
Sub FormatTableWithHeadersAndGrandTotal() Dim rng As Range Dim headerRow As Range Dim totalRow As Range Dim firstCol As Range Dim cell As Range Set rng = Selection ' Rangers Set headerRow = rng.Rows(1) Set totalRow = rng.Rows(rng.Rows.Count) Set firstCol = rng.Columns(1) ' Formatacao header With headerRow .Interior.Color = RGB(173, 216, 230) ' Cor Background .Font.Bold = True .Font.Color = RGB(255, 255, 255) ' Cor da Font .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With ' Primeira Linha With firstCol .Interior.Color = RGB(173, 216, 230) ' Cor Background .Font.Bold = True .Font.Color = RGB(0, 0, 0) 'Cor da Font .HorizontalAlignment = xlLeft .VerticalAlignment = xlCenter End With ' Ultima linha With totalRow .Interior.Color = RGB(191, 239, 255) ' Cor background .Font.Bold = True .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With ' Adicionar os Borders For Each cell In rng With cell.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .Color = RGB(0, 0, 0) End With With cell.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .Color = RGB(0, 0, 0) End With 'With cell.Borders(xlEdgeTop) ' .LineStyle = xlContinuous ' .Weight = xlThin ' .Color = RGB(0, 0, 0) ' End With ' With cell.Borders(xlEdgeBottom) ' .LineStyle = xlContinuous ' .Weight = xlThin ' .Color = RGB(0, 0, 0) 'End With Next cell ' Header e total Borders With headerRow.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThick .Color = RGB(0, 0, 0) End With With totalRow.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThick .Color = RGB(0, 0, 0) End With ' Width e Height rng.Columns.AutoFit rng.Rows.AutoFit End Sub
Leave a Comment