MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

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

    Exportação de consulta para o Excel

    Compartilhe

    Cleniroweb
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 57
    Registrado : 16/03/2014

    Exportação de consulta para o Excel

    Mensagem  Cleniroweb em Dom 10 Abr 2016, 08:08

    Caros Colegas,

    Preciso de um código VBA para exportar duas consultas para um mesmo documento do excel, ou seja, em duas abas distintas. Nesta exportação gostaria de formatar os cabeçalhos das planilhas para cor de célula em vermelho, o texto em branco e fonte para 10. Minhas consultas são:


    Consulta1
    Nome = "Cod_Cliente
    Coluna1 = Cod
    Coluna2 = Nome

    Consulta2
    Nome = Cod_Produto
    Coluna1 = Cod
    Coluna2 = Descricao

    Se alguém puder me ajudar com um código simples explicando passo a passo ou indicar um link com exemplos bons, ficarei muito agradecido.

    Obrigado,
    Cleniro.

    mediros2001
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 4
    Registrado : 17/04/2016

    Re: Exportação de consulta para o Excel

    Mensagem  mediros2001 em Seg 18 Abr 2016, 19:23

    Boa Tarde!

    Para fazer a exportação dos dados das consultas utilize o código abaixo dentro de um commandButton

    DoCmd.SetWarnings False

    DoCmd.RunSQL "SELECT Cliente.Cod, Cliente.Nome INTO Cod_Cliente FROM Cliente" 'Faça sua consulta conforme seus critérios, incluindo em uma tabela para transferência
    DoCmd.RunSQL "SELECT Produto.Cod, Produto.Descricao INTO Cod_Produto FROM Produto" 'Faça sua consulta conforme seus critérios, incluindo em uma tabela para transferência

    DoCmd.TransferSpreadsheet acExport, , "Cod_Cliente", "local_onde_o_arquivo_será_salvo\nome_do_arquivo.xlsx", True 'Transfere os dados obtidos na consulta para o arquivo excel
    DoCmd.TransferSpreadsheet acExport, , "Cod_Produto", "local_onde_o_arquivo_será_salvo\nome_do_arquivo.xlsx", True 'Transfere os dados obtidos na consulta para o arquivo excel

    DoCmd.RunSQL "DROP TABLE Cod_Cliente" 'Exclui as tabelas com os dados obtidos na consulta
    DoCmd.RunSQL "DROP TABLE Cod_Produto" 'Exclui as tabelas com os dados obtidos na consulta

    DoCmd.SetWarnings True

    Quanto a formatação, infelizmente não consigo ajudar.

    Cleniroweb
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 57
    Registrado : 16/03/2014

    Re: Exportação de consulta para o Excel

    Mensagem  Cleniroweb em Seg 02 Maio 2016, 02:46

    Mediros,

    Depois de algumas pesquisas na internet e alguns testes através do gravador de macros do excel, finalmente consegui e, no exemplo abaixo, exporto duas consultas no mesmo arquivo, sheet1 e sheet2, formato o cabeçalho, o corpo da planilha e incluo soma total ao final, no entanto tem um problema, estas minhas consultas tem um total de linhas conhecidas, desta forma coloco o total em uma linha específica (linha (375), mas se for uma consulta cujo o total de linhas não seja conhecido, neste caso não será possível colocar soma ao final do arquivo. Esse método tem me atendido bem, no entanto acredito que seja possível se fazer códigos melhor elaborados e se alguém puder ajudar nesta questão, agradeço.



    Private Sub CmdExp_Click()
    Dim rs As DAO.Recordset
    Dim arr, tamArr As Variant
    Dim xlapp As New Excel.Application

    With xlapp
    .Workbooks.Add
    .Visible = True
    .Worksheets(1).Select
    .Worksheets(1).Name = "ANALÍTICO-AR"
    Set rs = CurrentDb.OpenRecordset("Qry_Tbl_Exportar")
    .Range("A1").CopyFromRecordset rs
    .Range("A1").Cells.AutoFilter
    For x = 0 To rs.Fields.Count - 1
    xlapp.Cells(1, x + 1) = rs.Fields(x).Name
    '------------------------------------------------------------------------
    'Formantando somente o cabeçalho da planilha
    .ActiveWindow.DisplayGridlines = False
    .Range("B2").Activate
    .ActiveWindow.FreezePanes = True
    .Range("A1:J1").Font.Size = 9
    .Range("A1:J1").Font.Bold = True
    .Range("A1:J1").Font.Name = "Calibria"
    .Range("A1:J1").Font.ThemeColor = xlThemeColorDark1
    .Range("A1:J1").Interior.Color = 192
    .Range("A1:J1").HorizontalAlignment = xlCenter
    .Range("A1:J1").Borders.LineStyle = xlContinuous
    .Range("A1:J1").Borders.ThemeColor = 1
    .Range("A1:J1").Borders.Weight = xlThin
    .Range("A1:J1").Borders.TintAndShade = -0.249946592608417

    '------------------------------------------------------------------------
    'Formantando as demais linhas da planilha

    .Range("A2:J1000").Cells.Font.Size = 8
    .Range("A2:J1000").Font.Bold = False
    .Range("A2:J1000").Font.Name = "Calibria"
    .Range("A2:J1000").Borders.LineStyle = xlContinuous
    .Range("A2:J1000").Borders.ThemeColor = 1
    .Range("A2:J1000").Borders.Weight = xlThin
    .Range("A2:J1000").Borders.TintAndShade = -0.249946592608417

    '------------------------------------------------------------------------
    'Formatação individualizada por coluna

    xlapp.Columns("A").HorizontalAlignment = xlCenter
    xlapp.Columns("B").HorizontalAlignment = xlCenter
    xlapp.Columns("C").HorizontalAlignment = xlCenter
    xlapp.Columns("D").HorizontalAlignment = xlCenter
    xlapp.Columns("E").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    xlapp.Columns("E").HorizontalAlignment = xlRight
    xlapp.Columns("F").HorizontalAlignment = xlCenter
    xlapp.Columns("G").HorizontalAlignment = xlLeft
    xlapp.Columns("H").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    xlapp.Columns("H").HorizontalAlignment = xlRight
    xlapp.Columns("I").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    xlapp.Columns("I").HorizontalAlignment = xlRight
    xlapp.Columns("J").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    xlapp.Columns("J").HorizontalAlignment = xlRight

    '-------------------------------------------------------------------------

    Next x
    arr = Split(txtCaminho, "\")
    tamArr = UBound(arr)
    .Cells.Select
    .Cells.EntireColumn.AutoFit
    .Worksheets(2).Select
    .Worksheets(2).Name = "SALDO"
    Set rs = CurrentDb.OpenRecordset("Qry_Saldo")
    .Range("A1").CopyFromRecordset rs
    .Range("A1").Cells.AutoFilter
    For x = 0 To rs.Fields.Count - 1

    'Formatando colunas
    xlapp.Cells(1, x + 1) = rs.Fields(x).Name
    xlapp.Columns("A").HorizontalAlignment = xlCenter
    xlapp.Columns("B").HorizontalAlignment = xlLeft
    xlapp.Columns("C").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    xlapp.Columns("D").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    xlapp.Columns("E").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    xlapp.Columns("F").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    xlapp.Columns("G").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    xlapp.Columns("H").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    xlapp.Columns("I").NumberFormat = "#,##0.00_);[Red](#,##0.00)"

    '------------------------------------------------------------------------
    'Formantando somente o cabeçalho da planilha

    .ActiveWindow.DisplayGridlines = False
    .Range("B2").Activate
    .ActiveWindow.FreezePanes = True
    .Range("A1:I1").Font.Size = 9
    .Range("A1:I1").Font.Bold = True
    .Range("A1:I1").Font.Name = "Calibria"
    .Range("A1:I1").Font.ThemeColor = xlThemeColorDark1
    .Range("A1:I1").Interior.Color = 192
    .Range("A1:I1").HorizontalAlignment = xlCenter
    .Range("A1:I1").Borders.LineStyle = xlContinuous
    .Range("A1:I1").Borders.ThemeColor = 1
    .Range("A1:I1").Borders.Weight = xlThin
    .Range("A1:I1").Borders.TintAndShade = -0.249946592608417
     
    '------------------------------------------------------------------------
    'Formantando as demais linhas da planilha

    .Range("A2:I374").Cells.Font.Size = 8
    .Range("A2:I374").Font.Bold = False
    .Range("A2:I374").Font.Name = "Calibria"
    .Range("A2:I374").Borders.LineStyle = xlContinuous
    .Range("A2:I374").Borders.ThemeColor = 1
    .Range("A2:I374").Borders.Weight = xlThin
    .Range("A2:I374").Borders.TintAndShade = -0.249946592608417
    '------------------------------------------------------------------------


    'Formantando e incluíndo soma total no final da planilha

    .Range("A375:I375").Font.Size = 9
    .Range("A375:I375").Font.Bold = True
    .Range("A375:I375").Font.Name = "Calibria"
    .Range("A375:I375").Font.ThemeColor = xlThemeColorLight1
    .Range("A375:I375").Font.TintAndShade = 0
    .Range("A375:I375").Interior.Pattern = xlSolid
    .Range("A375:I375").Interior.PatternColorIndex = xlAutomatic
    .Range("A375:I375").Interior.ThemeColor = xlThemeColorDark1
    .Range("A375:I375").Interior.TintAndShade = -0.149998474074526
    .Range("A375:I375").Interior.PatternTintAndShade = 0
    .Range("A375:I375").Borders.LineStyle = xlContinuous
    .Range("A375:I375").Borders.ThemeColor = 1
    .Range("A375:I375").Borders.Weight = xlThin
    .Range("A375:I375").Borders.TintAndShade = -0.249946592608417

    'Incluindo a soma no final da planilha

    .Range("C2:C375").Select
       .Range("C375").Activate
       .ActiveCell.FormulaR1C1 = "=SUM(R[-374]C:R[-1]C)"
    .Range("D2:E375").Select
      .Range("D375").Activate
      .ActiveCell.FormulaR1C1 = "=SUM(R[-374]C:R[-1]C)"
    .Range("E2:E375").Select
      .Range("E375").Activate
      .ActiveCell.FormulaR1C1 = "=SUM(R[-374]C:R[-1]C)"
    .Range("F2:F375").Select
       .Range("F375").Activate
       .ActiveCell.FormulaR1C1 = "=SUM(R[-374]C:R[-1]C)"
    .Range("G2:G375").Select
       .Range("G375").Activate
       .ActiveCell.FormulaR1C1 = "=SUM(R[-374]C:R[-1]C)"
    .Range("h2:h375").Select
       .Range("h375").Activate
       .ActiveCell.FormulaR1C1 = "=SUM(R[-374]C:R[-1]C)"
    .Range("i2:i375").Select
       .Range("i375").Activate
       .ActiveCell.FormulaR1C1 = "=SUM(R[-374]C:R[-1]C)"
       .Range("A375").Activate
       .ActiveCell.FormulaR1C1 = "TOTAL"
     

    Next x
    arr = Split(txtCaminho, "\")
    tamArr = UBound(arr)
    .Cells.Select
    .Cells.EntireColumn.AutoFit
    End With

    Set rs = Nothing
    MsgBox "Arquivos exportados com sucesso", vbInformation, ""

      Data/hora atual: Dom 04 Dez 2016, 06:06