[Resolvido]Exportar cada campo de uma tabela para uma célula especifica no Excel

Boa Tarde pessoal,

O fórum tem me ajudado muito no meu projeto, mas estou tentando fazer algo que não consegui encontrar exemplos aqui.

Suponhamos que eu tenha uma tabela com 3 campos, cidade, estado e pais, e esses campos estejas preenchido com alguns dados.

Gostaria de exportar esses dados para uma tabela do Excel, porém, cada campo para células especificas.

Por Exemplo, o que estiver no campo cidade, vai para as células A1 até a A500;
O que estiver no campo estado, vai para a células C15 até a C600;
e o campo pais vai para a células G80 até G956;

Isso é só um exemplo, para ficar mais fácil de entender.

Porém se existir alguma maneira de fazer isso eu idia adaptar ao meu banco de dados.

Desde já agradeço

Há vários exemplos de exportação de uma tabela para o Excel no fórum. Tente adaptar os que tem objetos declarados como Recordset. Você pode fazer um loop pelo recordset e ir adicionando à planilha. Se a linha da planilha começa em 53 por exemplo, você pode fazer algo assim no loop:

Código:

Dim N As Double

Do While Not rs.EOF
    oExcel.Range("A" & N + 53) = rs!Cidade
    oExcel.Range("B" & N + 53) = rs!Estado
    oExcel.Range("C" & N + 53) = rs!Pais
    rs.MoveNext
    N = N + 1
Loop

Muito Obrigado pela sua ajuda Criquio;

Quero pedir desculpas pois ainda sou amador no Access, e algumas coisas eu ainda não compreendo corretamente.

Bom entendi seu código, e coloquei ele em um botão no meu formulário, porém, como era de se esperar, ele não executou corretamento, porque eu deveria inserir alguns comandos antes que ele executasse.

Então peguei um código do colega João Paulo aqui do fórum, que está funcionando, e tentei aproveitar a parte inicial dele, mas mesmo assim não funcionou.

Segue o código que tentei unir com o seu.

Código:

'By JPaulo ® Maximo Access
Dim rst As DAO.Recordset, strSQL As String, strLivro As String, xls As Object
Set xls = CreateObject("Excel.Application")
strLivro = CurrentProject.Path & "\teste.xls"
xls.Workbooks.Open (strLivro)
xls.Visible = True
strSQL = "SELECT * FROM Cad_Protocolo_Con;"
Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
Dim N As Double

Do While Not rs.EOF
    oExcel.Range("A" & N + 53) = rs!Cidade
    oExcel.Range("B" & N + 53) = rs!Estado
    oExcel.Range("C" & N + 53) = rs!Pais
    rs.MoveNext
    N = N + 1
Loop
Set xls = Nothing

End Sub

Ele da um erro, falando que o Objeto é obrigatório, e quando eu clico em Depurar, essa linha que está marcada de amarelo "Do While Not rs.EOF"

Você saberia me ajudar a resolver esse problema?

Obrigado.

Tente algo assim:

Código:

    Dim rs As Recordset, N As Integer, oApp As Object

    Set rs = CurrentDb.OpenRecordset("NomeDaTabela")
    Set oApp = CreateObject("Excel.Application")

    oApp.workbooks.Open CurrentProject.Path & "\Nome do arquivo.xls"
    oApp.Visible = False
    oApp.Worksheets("Plan1").Activate

    Do While Not rs.EOF
        oApp.ActiveSheet.Range("A" & N + 53) = rs!cidade
        oApp.ActiveSheet.Range("B" & N + 53) = rs!estado
        oApp.ActiveSheet.Range("C" & N + 53) = rs!pais
        rs.MoveNext
        N = N + 1
    Loop

    oApp.ActiveWorkbook.Save

    MsgBox "Pronto"

    rs.Close
    Set rs = Nothing

    oApp.Application.Quit
    Set oApp = Nothing


É preciso marcar a referência ao Microsoft Excel.

Obrigado Pela Ajuda Criquio,

Agora ele está mostrando a seguinte mensagem de erro. "Erro em tempo de execução '13': Tipos incompatíveis

E quando Clico em Depurar, ele destaca está linha: Set rs = CurrentDb.OpenRecordset("Cad_Protocolo_Con")

No caso Cad_Protocolo_Con é o nome da minha tabela que desejo exportar.

Sabe o que pode ser?

Esse underline no nome é porque tem espaços no nome da tabela tipo "Cad Protocolo Con" ou o nome da tabela está mesmo com underline? Se o nome tiver espaços, tente retirá-los alterando para CadProtocoloCon. E você marcou a referência do Microsoft Excel?

Sim, o nome da tabela possui os underline, ele é exatamente desse jeito que está digitado ai.

Quanto as Referencias eu selecionei a Microsoft Excel 15.0 Object Libray, conforme imagem abaixo.

Teria mais alguma solução?

Poste o código completo para analisarmos melhor.

Segue o Código Criquio;

Código:

Private Sub Comando3_Click()
    Dim rs As Recordset, N As Integer, oApp As Object

    Set rs = CurrentDb.OpenRecordset("Cad_Protocolo_Con")
    Set oApp = CreateObject("Excel.Application")
    oApp.Workbooks.Open CurrentProject.Path & "\teste.xls"
    oApp.Visible = False
    oApp.Worksheets("Plan1").Activate

    Do While Not rs.EOF
        oApp.ActiveSheet.Range("A" & N + 53) = rs![Protocolo:]
        rs.MoveNext
        N = N + 1
    Loop

    oApp.ActiveWorkbook.Save

    MsgBox "Pronto"

    rs.Close
    Set rs = Nothing

    oApp.Application.Quit
    Set oApp = Nothing

End Sub

rs![Protocolo:]

Existe mesmo esses dois pontos no final do nome do campo? Se sim, tente retirá-lo. Tambem pode retirar os colchetes. E a tabela está no próprio banco ou está em um backend separado do arquivo do formulário? Se estiver separado e desvinculado, terá que passar o caminho do backend.

Olá Criquio,

Fiz as alterações que você sugeriu, mas o erro persiste.

Segue um BD de teste para facilitar o entendimento.

Tente criar um banco novo e importar o formulário e a tabela para esse banco. Não se esquecendo de referenciar o Word novamente.

Olá Criquio,

Muito Obrigado pela sua ajuda, refiz o BD novamente, desde o inicio, e funcionou, ainda não descobri porque no meu BD não está funcionando, mas isso é um detalhe que logo eu resolvo.

O importante é que está funcionando perfeitamente, graças a você.

Muito Obrigado novamente, e vou deixar o BD aqui, caso alguém tenha a mesma dúvida que eu.

Obrigado

Isso acontece porque o banco pode estar com alguma referência AUSENTE. Nesse caso, basta desmarcar essa referência. Ou pode ser algum problema irreversível. Nesse caso, só mesmo importando tudo para um banco novo.