[Resolvido]Formatação de consulta exportada para o Excel

Olá a todos.

Procurei nos tópicos mas não encontrei o que eu busco.

Atualmente tenho no Access 2010 uma base e ao exportar a mesma gostaria que ela saísse com as colunas alinhadas, cabeçalho em negrito e também trocar a cor da fonte.

Não tenho nenhuma noção de como realizar no Access essa formatação.

Poderiam me ajudar no caminho das pedras?


Código da sub do botão que exporta:

Código:

Sub EXP_FAT()

Dim strConsulta, strNomePlanilha As Variant

DoCmd.SetWarnings False

strConsulta = "Q_989603000_CCUSTO"
strNomePlanilha = "\\BRSAO11FP03\Temp\989603000_ONE_RATEIO.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strConsulta, strNomePlanilha
strConsulta = "Q_989603000_GERAL"
strNomePlanilha = "\\BRSAO11FP03\Temp\989603000_ONE_RATEIO.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strConsulta, strNomePlanilha

strConsulta = "Q_989595000_CCUSTO"
strNomePlanilha = "\\BRSAO11FP03\Temp\989595000_AMIL_RATEIO.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strConsulta, strNomePlanilha
strConsulta = "Q_989595000_GERAL"
strNomePlanilha = "\\BRSAO11FP03\Temp\989595000_AMIL_RATEIO.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strConsulta, strNomePlanilha

strConsulta = "Q_989595001_CCUSTO"
strNomePlanilha = "\\BRSAO11FP03\Temp\989595001_AMIL_RATEIO.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strConsulta, strNomePlanilha
strConsulta = "Q_989595001_GERAL"
strNomePlanilha = "\\BRSAO11FP03\Temp\989595001_AMIL_RATEIO.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strConsulta, strNomePlanilha

strConsulta = "Q_989595002_CCUSTO"
strNomePlanilha = "\\BRSAO11FP03\Temp\989595002_AMIL_RATEIO.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strConsulta, strNomePlanilha
strConsulta = "Q_989595002_GERAL"
strNomePlanilha = "\\BRSAO11FP03\Temp\989595002_AMIL_RATEIO.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strConsulta, strNomePlanilha

strConsulta = "Q_989595004_CCUSTO"
strNomePlanilha = "\\BRSAO11FP03\Temp\989595004_AMIL_RATEIO.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strConsulta, strNomePlanilha
strConsulta = "Q_989595004_GERAL"
strNomePlanilha = "\\BRSAO11FP03\Temp\989595004_AMIL_RATEIO.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strConsulta, strNomePlanilha

strConsulta = "Q_989595005_CCUSTO"
strNomePlanilha = "\\BRSAO11FP03\Temp\989595005_AMIL_RATEIO.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strConsulta, strNomePlanilha
strConsulta = "Q_989595005_GERAL"
strNomePlanilha = "\\BRSAO11FP03\Temp\989595005_AMIL_RATEIO.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strConsulta, strNomePlanilha

MsgBox "Arquivos exportados com sucesso em \\BRSAO11FP03\Temp"

End Sub

Boa tarde.

Após revisitar os tópicos consegui chegar ao resultado final, me desculpem caso eu tenha aberto o tópico desnecessariamente.

Abaixo código final:

Código:

Private Sub CMD_REL_006159_Click()

Dim rs As DAO.Recordset
Dim arr, tamArr As Variant
Dim xlapp As New Excel.Application
Dim i As Integer
Dim iNumCols As Integer
Dim stgUltimalinha As String
Dim stgAutosoma As String
Dim stgUltimacoluna As String
Dim stgMesclar As String
Dim wsOrigem As Worksheet


With xlapp
xlapp.Workbooks.Add
xlapp.Visible = False
xlapp.Application.DisplayAlerts = False
xlapp.Worksheets(3).Delete
xlapp.Worksheets(2).Delete
xlapp.Worksheets(1).Select
xlapp.Worksheets(1).Name = "BUNGE ADM"
Set rs = CurrentDb.OpenRecordset("006159_GERAL")

iNumCols = rs.Fields.Count

For i = 1 To iNumCols
xlapp.Cells(1, i).Value = rs.Fields(i - 1).Name
Next

.Range("A2").CopyFromRecordset rs

xlapp.ActiveSheet.Range("A1:K1").Interior.Colorindex = 41
xlapp.ActiveSheet.Range("A1:K1").Font.Colorindex = 2
xlapp.ActiveSheet.Range("A1:K1").Borders.Colorindex = 0
xlapp.Columns("K").NumberFormat = "#,##0.00_);"
xlapp.Columns("A:C").HorizontalAlignment = xlCenter
xlapp.Columns("H:I").HorizontalAlignment = xlCenter
xlapp.Cells.EntireColumn.AutoFit
xlapp.ActiveWindow.DisplayGridlines = False
xlapp.Range("A1").Select



End With

Set rs = Nothing


xlapp.ActiveWorkbook.SaveAs FileName:="\\brsao11fp03\Temp\GERAL.xlsx"
xlapp.ActiveWorkbook.Close
xlapp.Application.DisplayAlerts = True

MsgBox "Arquivo exportado com sucesso em \\brsao11fp03\Temp\", vbInformation, ""

End Sub

Olá Walter Avelino,

Apesar de já ter passado algum tempo.
Obrigado pela partilha da solução, o fórum agradece.

Abraço