[Resolvido]Exportar para excel iniciando em célula específica e cabeçalho da coluna

Bom Dia.
Estou pretendendo utilizar um exemplo do JPaulo, que funciona perfeitamente.
porem não estou conseguindo enviar para as planilhas do excel o cabeçalho das colunas.
será que alguem teria uma solução.
o código:
Public Sub CriaExcel()
'By JPaulo ® Maximo Access
Dim strLivro As String, xls As Object
Dim db As DAO.Database
Dim rst, Rst1 As DAO.Recordset
Dim strSQL, strSQL1 As String
Dim x As String
Dim y As String
Dim z As String

Set db = CurrentDb
Set xls = CreateObject("Excel.Application")

strLivro = "C:\teste.xls" 'diretorio completo do ficheiro
xls.Workbooks.Open (strLivro)
xls.Visible = True

strSQL = "SELECT * FROM TabelaDasConsultas;"

Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
With rst

.MoveFirst

Do Until .EOF
z = rst.Fields.Item(1) 'nome da consulta na tabela
x = rst.Fields.Item(2) 'nome do sheet na tabela
y = rst.Fields.Item(3) 'nome da celula na tabela

strSQL1 = z

Set Rst1 = CurrentDb.OpenRecordset(strSQL1, dbOpenDynaset)
xls.Worksheets(x).Activate
xls.ActiveSheet.Range(y).Select
xls.ActiveCell.CopyFromRecordset Rst1
rst.MoveNext

Loop

End With
rst.Close
Rst1.Close
xls.ActiveWorkbook.Save
xls.Application.Quit
Set xls = Nothing
End Sub

"

obrigado.

Amigão esse código não envia os nomes dos campos.

Terá de ser outro.

Oi JPaulo,
que alternativa eu teria para enviar o cabeçalho das colunas.
mantendo o envio para célula específica ?

obrigado

Ok. JPaulo
Vou testar, só proforma, pois seus códigos sempre funcionam.
só mais uma coisa, esse código funcionaria tambem como fonte a tabela contendo o nome das consultas, planilhas(folhas) e célula inicial, como no seu exemplo "ConsultasParaExcel".

abraços

É tentei mas não consegui fazer dar resultado.
Tenho uma planilha com seis folhas, para receber os dados de seis consultas e queria que as folhas recebessem os dados (com cabeçalhos) à partir da célula A5.

o código CriaExcel, começa á partir da celula desejada mas não leva os cabeçalhos.
o código CriaExcelComCabeçalho, começa os dados a partir da celula desejada, mas não consegui colocar os cabeçalhos na célula anterior (só vai na célula A1).

Tentei fazer uma adaptação dos dois códigos, mas infelizmente não obtive exito.

se for possivel fazer, agradeço colaboração.

Bom dia Danilo;

Esta pequena alteração, vai inserir os cabeçalhos na célula que quiser, mas atenção que essa célula tem de ser sempre antes das células registradas na tabela, se não vai sobrepor os dados;

Neste exemplo a vermelho, corresponde à celula "A5" para inicio do cabeçalho;


Public Sub CriaExcel()
'By JPaulo ® Maximo Access
Dim strLivro As String, xls As Object
Dim db As DAO.Database
Dim rst, Rst1 As DAO.Recordset
Dim strSQL, strSQL1 As String
Dim x As String
Dim y As String
Dim z As String

Set db = CurrentDb
Set xls = CreateObject("Excel.Application")

strLivro = "C:\teste.xls" 'diretorio completo do ficheiro
xls.Workbooks.Open (strLivro)
xls.Visible = True

strSQL = "SELECT * FROM TabelaDasConsultas;"

Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
With rst

.MoveFirst

Do Until .EOF
z = rst.Fields.Item(1) 'nome da consulta na tabela
x = rst.Fields.Item(2) 'nome do sheet na tabela
y = rst.Fields.Item(3) 'nome da celula na tabela

strSQL1 = z

Set Rst1 = CurrentDb.OpenRecordset(strSQL1, dbOpenDynaset)
xls.Worksheets(x).Activate
xls.ActiveSheet.Range(y).Select

Dim i As Integer
Dim iNumCols As Integer
iNumCols = Rst1.Fields.Count
For i = 1 To iNumCols
xls.Cells(5, i).Value = Rst1.Fields(i - 1).Name
Next

xls.ActiveCell.CopyFromRecordset Rst1
rst.MoveNext

Loop

End With
rst.Close
Rst1.Close
xls.ActiveWorkbook.Save
xls.Application.Quit
Set xls = Nothing
End Sub

É como dizia minha Mãe; quem pode, pode; quem não pode, se sacode.

e como voce mesmo diz: funfou maravilha.

só acrescentei nesta parte:

Dim i As Integer
Dim iNumCols As Integer
iNumCols = Rst1.Fields.Count
For i = 1 To iNumCols
xls.Cells(5, i).Value = Rst1.Fields(i - 1).Name

xls.Cells(5, i).Font.Bold = True 'cabeçalhos em negrito

xls.Cells(5, i).EntireColumn.AutoFit 'Dimensionamento das colunas


Next


Ficou tudo exatamente como eu precisava.

agora só falta ganharmos a EURO.



um abraço e obrigado.

Obrigado pelo retorno o fórum agradece.

Desta vez eu coloco o Resolvido.

putz, desculpe. obrigado.

Olá Feras de plantão,
Copiei e colei o código acima, ele abre o excel, porém da erro na seguinte linha:
Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
O access retorna com a mensagem que eram esperados dois resultados, alguém pode me ajudar?

Habilite a Referencia VBA Microsoft 12.0 object library (Ms Access 2007)
Ou Microsoft 11.0 object library (Ms Access 2003)

O meu é access 2010.

Não tenho o 2010, mas a referencia terá de ser a 14.0

Oi JPaulo,

Consultei as referências e a 14.0 já estava habilitada.
Tem alguma outra idéia de onde pode estar o erro?

Amigão gostaria muito de o ajudar, mas não tenho o Ms Access 2010 para efetuar testes.

Se alguma fera por aqui tiver, concerteza que o vai ajudar.