[Resolvido]Exportar tabela para Excel incluindo formatação após Loop

Boa tarde galera.

Tenho este código que exporta para uma Planilha Excel e está funcionando perfeitamente.
Acontece que preciso incluir após o Loop outros dados fixos no rodapé tais como: Total de Ítens, texto livre, Nome do usuário e e-mail do mesmo, além de uma linha separando este rodapé.

Segue o código, já procurei bastante aqui e na net, mas nada feito. Pouco conheço de chamadas de Excel, por isso peço ajuda dos amigos.

Código:


Dim intLinha As Integer
Dim intColuna As Integer

'Variaveis do excel
Dim xl As New Excel.Application
Dim xlw As Excel.Workbook
Dim i As Integer
Dim N As Integer
Dim intcontador As Integer
Dim intContadorPag As Integer

Dim CaminhoPlanilha As String
On Error GoTo Fim

Dim Rst1 As Recordset
Dim rst2 As Recordset
Dim Sel1 As String
Dim Sel2 As String

'Obtenho o caminho do carquivo
'----------------------------------------------------------------------
CaminhoPlanilha = CurrentProject.Path & "\COTAÇÃO - " & Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]!id_cotacao_gerada & ".xlsx"

   
    'Call filtra_listbox
   
    'Carrego o conjunto de registros
    Sel1 = "SELECT * from cotacao_sub_temp"

   
    Set Rst1 = CurrentDb.OpenRecordset(Sel1)
   
    'Inicio o contador da linha
    intLinha = 11
   
    'Abrir o arquivo do Excel
    Set xlw = xl.Workbooks.Open(CurrentProject.Path & "\COTAÇÃO - " & Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]!id_cotacao_gerada & ".xlsx")
       
    'Aqui inicio o loop pelos registros da tabela
    Do While Not Rst1.EOF
    '--------------------------------------------------------------

        'Definimos qual será a planilha de trabalho
        xlw.Sheets("COTAÇÃO").Select

        'Envia o valor para cada celula (Linha, Coluna)
        xlw.Application.Cells(intLinha, 1).Value = Rst1![Item]          'Item
        xlw.Application.Cells(intLinha, 2).Value = Rst1![quant]        'quant
        xlw.Application.Cells(intLinha, 3).Value = Rst1![unidade]      'unidade
        xlw.Application.Cells(intLinha, 4).Value = Rst1![txt_produto]  'txt_produto
        xlw.Application.Cells(intLinha, 5).Value = Rst1![codigo_ncm]    'codigo_ncm
        xlw.Application.Cells(intLinha, 6).Value = "-"    'ipi
        xlw.Application.Cells(intLinha, 7).Value = "-"    'valor_unit
        xlw.Application.Cells(intLinha, 8).Value = "-"    'valor_total
       
        'Incremento o contador para mudar a planilha
        intLinha = intLinha + 1
    '--------------------------------------------------------------
    Rst1.MoveNext
    Loop
   
    'Finalizo o loop
    Rst1.Close

      ' ContaItens = DCount("*", "cotacao_sub_temp")
        'xlw.ActiveSheet.Range(xlw.ActiveSheet.Cells(ContaItens + 12, 1), xlw.ActiveSheet.Cells(ContaItens + 12, 2)).Merge
      ' xlw.ActiveSheet.Cells(ContaItens + 12, 1) = "Total de Ítens: " & ContaItens


    'Para não salvar mude true para false
    xlw.Close True

    'Liberamos a memória
    Set xlw = Nothing
    Set xl = Nothing
'--------------------------------------------------------------

Exit Function

Fim:
    SysCmd 3
    MsgBox err.Number & " - " & err.Description
    Exit Function


Quando você diz: "uma linha separando o rodapé" ... você quer dizer uma borda acima ou uma linha extra?

Se for uma borda, tenta colar o seguinte código logo após o loop

Código:


With xlw.Application.range("A" & intLinha & ":H" & intLinha).Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
   
With xlw.Application
    .Cells(intLinha, 1).Value = "Total de itens: " & intLinha - 11
    .Cells(intLinha, 2).Value = "Texto livre"
    .Cells(intLinha, 3).Value = "Usuário"
    .Cells(intLinha, 4).Value = "e-mail"
End With


Se for apenas uma linha extra depois dos dados, tenta esse código logo após o loop

Código:


With xlw.Application
    .Cells(intLinha+1, 1).Value = "Total de itens: " & intLinha - 11
    .Cells(intLinha+1, 2).Value = "Texto livre"
    .Cells(intLinha+1, 3).Value = "Usuário"
    .Cells(intLinha+1, 4).Value = "e-mail"
End With


Renato boa noite.
Cara, era exatamente isso que eu precisava.
Vou ajustar aqui pra ficar com layout legal.

Só mais um detalhe, há como fazer com que as bordas das células sejam exibidas?

Assim finalizo este projeto.
Obrigado mesmo pela ajuda.

Só mais um detalhe, há como fazer com que as bordas das células sejam exibidas?

Dá sim. Porém, eu sugiro que você crie uma Sub para executar esse comando, já que vai repetir várias vezes.
Segue o exemplo da Sub:

Código:


Sub popularCelula(objExcel, linha, coluna, valor)
With objExcel.Application.Cells(linha, coluna)
    .Value = valor
    With .Borders
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
    End With
End With
End Sub


No seu código você chamaria assim:

Código:


call popularCelula(xlw, intLinha, 1, Rst1![Item])
call popularCelula(xlw, intLinha, 2, Rst1![quant])
call popularCelula(xlw, intLinha, 3, Rst1![unidade])
call popularCelula(xlw, intLinha, 4, Rst1![txt_produto])
call popularCelula(xlw, intLinha, 5, Rst1![codigo_ncm])
call popularCelula(xlw, intLinha, 6, "-")
call popularCelula(xlw, intLinha, 7, "-")
call popularCelula(xlw, intLinha, 8, "-")


Renato boa tarde.
Cara nem sei como agradecer, está tudo muito perfeito.
Demorei pra responder porquê além do horário de expediente, tive que mexer no código pra ficar um layout legal.

Mas ainda preciso de uma última ajuda, prometo que é a última mesmo.

Veja como ficou.

Código:


Public Function ExportaItens_Cotação()

'Variaveis do excel
Dim intLinha As Integer
Dim intColuna As Integer

Dim xl As New Excel.Application
Dim xlw As Excel.Workbook
Dim i As Integer
Dim N As Integer
Dim intcontador As Integer
Dim intContadorPag As Integer

Dim CaminhoPlanilha As String
On Error GoTo Fim

Dim Rst1 As Recordset
Dim rst2 As Recordset
Dim Sel1 As String
Dim Sel2 As String

'Obtenho o caminho do carquivo
'----------------------------------------------------------------------
CaminhoPlanilha = CurrentProject.Path & "\COTAÇÃO - " & Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]!id_cotacao_gerada & ".xlsx"
   
    'Carrego o conjunto de registros
    Sel1 = "SELECT * from cotacao_sub_temp"

   
    Set Rst1 = CurrentDb.OpenRecordset(Sel1)
   
    'Inicio o contador da linha
    intLinha = 11
   
    'Abrir o arquivo do Excel
    Set xlw = xl.Workbooks.Open(CurrentProject.Path & "\COTAÇÃO - " & Forms![4-COTAÇÃO_MONTA_LISTA_PRODUTOS]!id_cotacao_gerada & ".xlsx")
       
    'Aqui inicio o loop pelos registros da tabela
    Do While Not Rst1.EOF
    '--------------------------------------------------------------

        'Definimos qual será a planilha de trabalho
        xlw.Sheets("COTAÇÃO").Select

        'Envia o valor para cada celula (Linha, Coluna)
       
        xlw.Application.Cells(intLinha, 1).Value = Rst1![Item]
        xlw.Application.Cells(intLinha, 2).Value = Rst1![quant]
        xlw.Application.Cells(intLinha, 3).Value = Rst1![unidade]
       
        xlw.Application.Cells(intLinha, 4).WrapText = True              'Quebra o texto
        xlw.Application.Cells(intLinha, 4).Rows.AutoFit                'Ajusta a altura
        xlw.Application.Cells(intLinha, 4).Value = Rst1![txt_produto]
       
        xlw.Application.Cells(intLinha, 5).Value = Rst1![codigo_ncm]
        xlw.Application.Cells(intLinha, 6).Value = "-"                  'ipi
        xlw.Application.Cells(intLinha, 7).Value = "-"                  'valor_unit
        xlw.Application.Cells(intLinha, 8).Value = "-"                  'valor_total
       
        'Chama a Função para desenhar as bordas da lista de Produtos
        Call BordasCelulaExcel(xlw, intLinha, 1, Rst1![Item])
        Call BordasCelulaExcel(xlw, intLinha, 2, Rst1![quant])
        Call BordasCelulaExcel(xlw, intLinha, 3, Rst1![unidade])
        Call BordasCelulaExcel(xlw, intLinha, 4, Rst1![txt_produto])
        Call BordasCelulaExcel(xlw, intLinha, 5, Rst1![codigo_ncm])
        Call BordasCelulaExcel(xlw, intLinha, 6, " ")
        Call BordasCelulaExcel(xlw, intLinha, 7, " ")
        Call BordasCelulaExcel(xlw, intLinha, 8, " ")

        'Incremento o contador para mudar a linha
        intLinha = intLinha + 1
    '--------------------------------------------------------------
    Rst1.MoveNext
    Loop
   
    'Finalizo o loop
    Rst1.Close

    'Inicio a montagem do Rodapé após a lista de produtos
    With xlw.Application
    .Cells(intLinha + 1, 1).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 1, 1).WrapText = False                'Quebra o texto
    .Cells(intLinha + 1, 1).Font.Bold = True                'Fonte em Nrgito
    .Cells(intLinha + 1, 1).Font.Size = 12                  'Tamanho da Fonte
    .Cells(intLinha + 1, 1).Value = "Nº ÍTENS: " & intLinha - 11
   
    .Cells(intLinha + 1, 7).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 1, 7).WrapText = False                'Quebra o texto
    .Cells(intLinha + 1, 7).Font.Bold = True                'Fonte em Nrgito
    .Cells(intLinha + 1, 7).Font.Size = 12                  'Tamanho da Fonte
    .Cells(intLinha + 1, 7).Value = "TOTAL:"
   
    .Cells(intLinha + 3, 2).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 3, 2).WrapText = False                'Quebra o texto
    .Cells(intLinha + 1, 1).Font.Size = 11                  'Tamanho da Fonte
    .Cells(intLinha + 3, 2).Value = "Atenciosamente,"
   
    .Cells(intLinha + 4, 2).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 4, 2).WrapText = False                'Quebra o texto
    .Cells(intLinha + 1, 1).Font.Size = 11                  'Tamanho da Fonte
    .Cells(intLinha + 4, 2).Value = "Usuário"
   
    .Cells(intLinha + 5, 2).HorizontalAlignment = xlLeft    'Alinha texto a esquerda
    .Cells(intLinha + 5, 2).WrapText = False                'Quebra o texto
    .Cells(intLinha + 1, 1).Font.Size = 11                  'Tamanho da Fonte
    .Cells(intLinha + 5, 2).Value = "e-mail"
    End With

 
    'Para não salvar mude true para false
    xlw.Close True

    'Liberamos a memória
    Set xlw = Nothing
    Set xl = Nothing
'--------------------------------------------------------------

Exit Function

Fim:
    SysCmd 3
    MsgBox err.Number & " - " & err.Description
    Exit Function
End Function


Como faço para numerar com sequência a célula no Excel, independente da quantidade de itens.
Tipo:
1
2
3
4
5

Obrigado irmão.

Usa a variável intLinha que você definiu anteriormente pra iterar o loop.

Como, no seu caso, ela começa em 11, dentro do loop você vai fazer algo mais ou menos assim:

Código:

Call BordasCelulaExcel(xlw, intLinha, 1, intLinha - 10)

Perfeito Renato!!!

Obrigado pela grande ajuda irmão.

Conte comigo sempre!

Abraço e espero poder ajudar no futuro. Rsrs.

Tópico Resolvido.

Sucesso, Cláudio. Pode contar comigo também.

Valeu irmão.