Excel planilha vba soma subtotal e total em quebra de paginas

Sex, 04 de Março de 2011 16:20 Expedito Marcondes
Imprimir

Saberexcel - O site de quem precisa aprender Macros Microsoft Excel VBA

Essa macro do Aplicativo Microsoft Excel VBA(Visual Basic Application), insere uma soma(total) e Subtotal, em quebra de páginas na folha de planilha.
esse tipo de macros é muito procurada, porém não é tão abundante assim, aconselho que a guarde, em seus arquivos.
Veja que usei a Função de Planilha soma(WorksheetFunction) para retornar o Valor, não foi preciso fórmulas para retornar as somas.
Não deixe de Ver sobre 340 Planilhas WorksheetFunctions(VBA) Saberexcel - onde foi possível, fizemos um exemplo para cada função do Aplicativo Excel.    340 Exemplos de Planilhas  (WorkSheetFunction) Funções de Planilhas retornam valores vba


Sub Inserir_totais_subtotais_em_quebra_paginas()
Dim i As Byte
Dim vUltima_Linha As Integer, vLinha As Integer, vPagina As Integer
Dim vTotal As Double

vLinha = 1
vUltima_Linha = Range("A65536").End(xlUp).Row

ActiveSheet.HPageBreaks.Add Before:=Cells(vUltima_Linha + 1, 1)
vTotal = Application.WorksheetFunction.Sum(Range("A1:A" & vUltima_Linha))

Application.ScreenUpdating = False
For i = 1 To ActiveSheet.HPageBreaks.Count
    vPagina = ActiveSheet.HPageBreaks(i).Location.Row
    Rows(vPagina).Insert

    With Cells(vPagina, 1)
       .Value = Application.WorksheetFunction.Sum(Range("A" & vLinha & ":A" & vPagina - 1))
       .Interior.ColorIndex = 3
    End With

    vLinha = vPagina + 1
Next i

With Cells(vPagina + 1, 1)
   .Value = vTotal
   .Interior.ColorIndex = 5
End With

Application.ScreenUpdating = True
End Sub

 

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos SaberExcel 





Acesso Livre - Registrados (REGISTRE-SE!)  
 Baixe o exemplo de planilha contendo o macro acima
Excel planilha vba soma total subtotal quebra de linhas planilha (24.37 KB)

 

Publicidade
Compre com segurança, garantia e ótimos preços
Eletrônicos - Submarino.com.br

Tags:
Última atualização em Ter, 23 de Agosto de 2011 09:01