Excel VBA - Criar razonetes ou contas T automaticamente

Objetivo: Disponibilizar um procedimento VBA para criar razonetes, também chamadas como Contas T de forma automática no Excel.

Conforme a Wikipédia "Nas ciências contábeis, razonete é uma ferramenta e uma representação gráfica em forma de "T" bastante utilizada pelos contadores. É um instrumento didático para desenvolver o raciocínio contábil. Através do razonete são feitos os registros individuais por conta, dispensando-se o método por balanços sucessivos. Como o balanço, o razonete tem dois lados; na parte superior do razonete coloca-se o título da conta que será movimentada. Posteriormente, os resultados individuais são transferidos para oBalanço Patrimonial para criação do demonstrativo contábil.".

O código VBA descrito abaixo realiza a criação automática de razonetes, facilitando os estudos contábeis, acredito que possa ser muito útil para os Contadores e analistas de sistema da área.

Sub lsCriaContaT()
    ActiveCell.Resize(, 2).Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    ActiveCell.Offset(1, 1).Select
    ActiveCell.Resize(6).Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    ActiveCell.Offset(0, -1).Range("A1").Select

    'Gera as contas
    ActiveCell.Offset(5).Select
    ActiveCell.Resize(, 2).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    'Fórmulas
    Selection.Resize(1, 1).Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUM(R[-5]C:R[-1]C)-SUM(R[-5]C[1]:R[-1]C[1])>0,SUM(R[-5]C:R[-1]C)-SUM(R[-5]C[1]:R[-1]C[1]),0)"
    Selection.Offset(0, 1).Select
    Selection.Resize(1, 1).Select
    ActiveCell.FormulaR1C1 = _
        "=IF(SUM(R[-5]C:R[-1]C)-SUM(R[-5]C[-1]:R[-1]C[-1])>0,SUM(R[-5]C:R[-1]C)-SUM(R[-5]C[-1]:R[-1]C[-1]),0)"
    Selection.Offset(0, -1).Select
    Selection.Resize(1, 2).Select
    Selection.Style = "Comma"
    Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"

    Selection.Resize(1, 1).Select
    Selection.Offset(-5).Select

    Selection.Offset(-1).Select
    Selection.Resize(1, 2).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Selection.Font.Bold = True
End Sub

Para colocar o procedimento como global você deve seguir os procedimentos em http://guiadoexcel.com.br/habilitando-a-guia-desenvolvedor-e-copiando-procedimentos-vba-sub-da-internet, depois é só associar a um atalho este comando e você terá a criação automática de razonetes.

DIGITE O SEU EMAIL PARA FAZER O DOWNLOAD DOS ARQUIVOS:

Abraço

Marcos Rieper