MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

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

    Cláudio Machado
    Cláudio Machado
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1593
    Registrado : 17/03/2011

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

    Mensagem  Cláudio Machado em 3/2/2020, 19:45

    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


    .................................................................................
    " Nunca cruze os braços diante de qualquer problema ou dificuldade, pois o maior homem do mundo Jesus,  morreu de braços abertos."

    Agradeça e feche o tópico clicando no botão Resolvido. Se não sabe como, veja  AQUI.
    Não esqueça de clicar no Joinha [Resolvido]Exportar tabela para Excel incluindo formatação após Loop 90dssg para agradecer a dica que solucionou seu problema.
    avatar
    renpv
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 318
    Registrado : 12/01/2015

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

    Mensagem  renpv em 4/2/2020, 00:31

    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
    Cláudio Machado
    Cláudio Machado
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1593
    Registrado : 17/03/2011

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

    Mensagem  Cláudio Machado em 4/2/2020, 00:59

    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.


    .................................................................................
    " Nunca cruze os braços diante de qualquer problema ou dificuldade, pois o maior homem do mundo Jesus,  morreu de braços abertos."

    Agradeça e feche o tópico clicando no botão Resolvido. Se não sabe como, veja  AQUI.
    Não esqueça de clicar no Joinha [Resolvido]Exportar tabela para Excel incluindo formatação após Loop 90dssg para agradecer a dica que solucionou seu problema.
    avatar
    renpv
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 318
    Registrado : 12/01/2015

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

    Mensagem  renpv em 4/2/2020, 13:15

    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, "-")
    Cláudio Machado
    Cláudio Machado
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1593
    Registrado : 17/03/2011

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

    Mensagem  Cláudio Machado em 5/2/2020, 15:49

    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.



    .................................................................................
    " Nunca cruze os braços diante de qualquer problema ou dificuldade, pois o maior homem do mundo Jesus,  morreu de braços abertos."

    Agradeça e feche o tópico clicando no botão Resolvido. Se não sabe como, veja  AQUI.
    Não esqueça de clicar no Joinha [Resolvido]Exportar tabela para Excel incluindo formatação após Loop 90dssg para agradecer a dica que solucionou seu problema.
    avatar
    renpv
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 318
    Registrado : 12/01/2015

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

    Mensagem  renpv em 5/2/2020, 17:21

    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)
    Cláudio Machado
    Cláudio Machado
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1593
    Registrado : 17/03/2011

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

    Mensagem  Cláudio Machado em 5/2/2020, 17:43

    Perfeito Renato!!! cheers

    Obrigado pela grande ajuda irmão.

    Conte comigo sempre!

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

    Tópico Resolvido.


    .................................................................................
    " Nunca cruze os braços diante de qualquer problema ou dificuldade, pois o maior homem do mundo Jesus,  morreu de braços abertos."

    Agradeça e feche o tópico clicando no botão Resolvido. Se não sabe como, veja  AQUI.
    Não esqueça de clicar no Joinha [Resolvido]Exportar tabela para Excel incluindo formatação após Loop 90dssg para agradecer a dica que solucionou seu problema.
    avatar
    renpv
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 318
    Registrado : 12/01/2015

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

    Mensagem  renpv em 5/2/2020, 23:50

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

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1593
    Registrado : 17/03/2011

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

    Mensagem  Cláudio Machado em 5/2/2020, 23:52

    Valeu irmão.


    .................................................................................
    " Nunca cruze os braços diante de qualquer problema ou dificuldade, pois o maior homem do mundo Jesus,  morreu de braços abertos."

    Agradeça e feche o tópico clicando no botão Resolvido. Se não sabe como, veja  AQUI.
    Não esqueça de clicar no Joinha [Resolvido]Exportar tabela para Excel incluindo formatação após Loop 90dssg para agradecer a dica que solucionou seu problema.

      Data/hora atual: 13/8/2020, 15:10