Untitled

mail@pastecode.io avatar
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