Notifications
Clear all

Refatorar o código de criação de Bordas

3 Posts
2 Usuários
0 Reactions
851 Visualizações
(@gilbertjrs)
Posts: 0
New Member
Topic starter
 

Boa tarde.

Estou criando uma planilha e uma das atividades que não soube realizar diretamente no código é a de criar bordas, gravei uma macro, criei uma função que recebe um range e executa este código.

O gravador de macros sempre gera muitas linhas desnecessários, em alguns casos já reescrevi um código mais enxuto porém, tem um situação que ainda me incomoda é a criação de bordas, segue o código:

    Sheets("Plan 1").Range("A2:H30).Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -4.99893185216834E-02
        .PatternTintAndShade = 0
    End With

Obs.: Os ranges são passados por parâmetro para a função, coloquei um range fixo aqui no forúm somente para facilitar a explicação.

Alguém sabe como posso enxugar este código?

 
Postado : 16/03/2017 10:43 am
(@mprudencio)
Posts: 0
New Member
 

Com base no seu codigo pode usar esse


Sub bordas()
    
    With Sheets("Plan1").Range("A2:H30")
    
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Borders(xlInsideVertical).Weight = xlHairline
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).Weight = xlHairline
    .Interior.ThemeColor = xlThemeColorDark1
    .Interior.TintAndShade = -4.99893185216834E-02
    
    End With
    
End Sub


 
Postado : 16/03/2017 11:39 am
(@gilbertjrs)
Posts: 0
New Member
Topic starter
 

Grato, resolvido.

 
Postado : 16/03/2017 1:28 pm