Exportação de consulta para o Excel

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.

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.

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, ""