[Resolvido]Enviar todos os Valores de um SubFormulário

Olá pessoal boa tarde, estou abrindo esse tópico para tentar resolver o meu problema, pesquisei aqui no fórum e vi esse tópico:

https://www.maximoaccess.com/t17637-resolvidocomo-enviar-todos-os-registros-de-um-subformulario-do-access-para-o-word

Não sei bem se tem como vincular, mas é o mesmo meu problema tenho esse código:

Código:

.ActiveDocument.Bookmarks("Cod").Select
        .Selection.Text = Trim(CStr(Forms!FormulárioContratosdeAdm!DetalhamentoCadastroImóveisSub.Form!CodImovel))
        .ActiveDocument.Bookmarks("Endereço").Select
        .Selection.Text = Trim(CStr(Forms!FormulárioContratosdeAdm!DetalhamentoCadastroImóveisSub.Form!Endereco))
        .ActiveDocument.Bookmarks("N").Select
        .Selection.Text = Trim(CStr(Forms!FormulárioContratosdeAdm!DetalhamentoCadastroImóveisSub.Form!N))

Porém não sei porque ele só esta pegando os valores do 1 registro e não todos os valores, sendo que estão ligados o SubFormulário Campo filho e campo mestre entre os 2 formulários FormulárioContratosdeAdm e DetalhamentoCadastroImóveisSub pelo Código.

Onde está o meu erro ? o que está errado ?

Se alguém puder me ajudar, desculpe a reabertura no fórum deste assunto mas vi que não foi postado a solução anterior.

Desde já agradeço a quem poder ajudar.

Abraço

Você já considerou criar um recordset filtrado pelo campo do formulário pai?

Desculpe mas com base nesse exemplo como ficaria ? Não sei como poderia fazer dai...

Buscando ajudar com o problema e principalmente com a evolução profissional dos colegas, deixo exemplo de como funcionam e se trabalha com recordsets

youtube.com/watch?v=c8Mqfvtrs7s
youtube.com/watch?v=pvxWXjAXhos

Também aqui tópico onde usuário usa recordsets para popular uma tabela no word
https://www.maximoaccess.com/t35982-resolvidobookmark-error-13-empty

Olá IvanJr ! Obrigado pelo retorno, vou tentar ver se consigo colocar em prática essas informações e posto o retorno com o resolvido se for o caso.

Agradeço desde já !

Abraço !

Olá IvanJr, desculpe mas assisti aos videos e não consegui fazer funcionar na prática resolvi disponibilizar o código completo para uma melhor resolução de meu problema e ajuda dos amigos:

Código:

Dim DocWord As Object
Dim db As Database, rs As Recordset

      Set db = CurrentDb()

Set rs = CurrentDb.OpenRecordset("SELECT CodImovel,CodProprietario,Endereco,N,Complemento FROM DetalhamentoCadastroImóveis WHERE CodImovel=" & Me.CódProprietario & "")

    'Inicia o MS Word
    Set oApp = CreateObject("Word.Application") 'Cria e abre o objeto Word
  
    With oApp
        'Torna o MS Word visível
        Visible = True
        'Torna o MS Word visível
        Visible = True
        'Abre o documento base
        .Documents.Open (CurrentProject.path & "\Contrato de Administração.doc")
        '--------Fecha recordset e limpa da memória-------
         rs.Close
         Set rs = Nothing
        '-------------------------------------------------
        
        'Move cada campo para o indicador definido no documento
        .ActiveDocument.Bookmarks("Proprietario").Select
        .Selection.Text = Proprietario

        If Not IsNull(Me.RGLocad) Then
            .ActiveDocument.Bookmarks("RGLocad").Select
            .Selection.Text = Trim(CStr(Format(Me.RGLocad, "00\.000\.0000\-0")))
        Else
            .ActiveDocument.Bookmarks("RGLocad").Select
            .Selection.Text = ""
        End If

        .ActiveDocument.Bookmarks("CPFLocad").Select
        .Selection.Text = Trim(CStr(Format(CPFLocad, "000\.000\.000\-00")))
        .ActiveDocument.Bookmarks("NacionalidadeLocad").Select
        .Selection.Text = NacionalidadeLocad

        If Me.RegimedeCasamento = "Universal" Then
            .ActiveDocument.Bookmarks("EstadoCivilLocad").Select
            .Selection.Text = ""
        Else
            .ActiveDocument.Bookmarks("EstadoCivilLocad").Select
            .Selection.Text = EstadoCívilLocad
        End If

        .ActiveDocument.Bookmarks("NaturalidadeLocad").Select
        .Selection.Text = NaturalidadeLocad
        .ActiveDocument.Bookmarks("UFLocad").Select
        .Selection.Text = UFLocad
        .ActiveDocument.Bookmarks("ProfissãoLocad").Select
        .Selection.Text = ProfissãoLocad

        If Not IsNull(Me.Texto) Then
        .ActiveDocument.Bookmarks("Texto").Select
        .Selection.Text = Texto
        Else
        .ActiveDocument.Bookmarks("Texto").Select
        .Selection.Text = ""
        End If
        .ActiveDocument.Bookmarks("xx").Select
        .Selection.Text = PercentualComissão
        .ActiveDocument.Bookmarks("Extenso").Select
        .Selection.Text = PercentualExtenso
         'Move cada campo para o indicador definido no documento ref ao subformulário
        .ActiveDocument.Bookmarks("Cod").Select
        .Selection.Text = Trim(CStr(Forms!FormulárioContratosdeAdm!DetalhamentoCadastroImóveisSub.Form!CodImovel))
        .ActiveDocument.Bookmarks("Endereço").Select
        .Selection.Text = Trim(CStr(Forms!FormulárioContratosdeAdm!DetalhamentoCadastroImóveisSub.Form!Endereco))
        .ActiveDocument.Bookmarks("N").Select
        .Selection.Text = Trim(CStr(Forms!FormulárioContratosdeAdm!DetalhamentoCadastroImóveisSub.Form!N))
        If Not IsNull(Complemento) Then
        .ActiveDocument.Bookmarks("Complemento").Select
        .Selection.Text = Trim(CStr(Forms!FormulárioContratosdeAdm!DetalhamentoCadastroImóveisSub.Form!Complemento))
        Else
        .Selection.Text = ""
        End If
    
        'Salva o arquivo gerado
        .ActiveDocument.SaveAs ("C:\Users\Usuário\Desktop\Projeto Programa\Imóveis\ContratosGerados") & "\" & "ContratodeAdministração_Nº " & Replace(Me.Código, "/", "-") & ".doc"
        MsgBox "Documento WORD gerado com sucesso...", vbInformation
        'Fecha o documento
        .ActiveDocument.Close
        'Fecha o Word
        oApp.Quit

        If MsgBox("Deseja abrir o documento agora?", vbYesNo, "Excluir") = vbYes Then
        'Abre o documento
        'Winword em qualquer computador
            Shell ("WINWORD" & " " & """C:\Users\Usuário\Desktop\Projeto Programa\Imóveis\ContratosGerados\" & "ContratodeAdministração_Nº " & Me.Código & ".doc"""), vbMaximizedFocus
        Else
            Cancel = True
        End If

        Set oApp = Nothing
        Set rs = Nothing
        Set db = Nothing

    End With

    Exit Sub

    End Sub


Neste treixo do código é que estão os campos que só está saindo no Word, o 1º registro da tabela "DetalhamentoCadastroImóveis" e não todos correspondentes:

Código:

.ActiveDocument.Bookmarks("Cod").Select
        .Selection.Text = Trim(CStr(Forms!FormulárioContratosdeAdm!DetalhamentoCadastroImóveisSub.Form!CodImovel))
        .ActiveDocument.Bookmarks("Endereço").Select
        .Selection.Text = Trim(CStr(Forms!FormulárioContratosdeAdm!DetalhamentoCadastroImóveisSub.Form!Endereco))
        .ActiveDocument.Bookmarks("N").Select
        .Selection.Text = Trim(CStr(Forms!FormulárioContratosdeAdm!DetalhamentoCadastroImóveisSub.Form!N))
        If Not IsNull(Complemento) Then
        .ActiveDocument.Bookmarks("Complemento").Select
        .Selection.Text = Trim(CStr(Forms!FormulárioContratosdeAdm!DetalhamentoCadastroImóveisSub.Form!Complemento))
        Else
        .Selection.Text = ""
        End If

Se alguém poder me ajudar. Agradeço !

Leonardo, boa tarde!

O que estou entendendo o que você quer fazer é transferir dados de uma tabela para outra tabela em um Word, certo?

Não destrinchei todo o código mas, parece que está faltando fazer um loop no recordset para percorrer todos os registros, e um por vez ir transferindo para a tabela do Word.

Exemplo:

Código:

rs.MoveFirst

Do While Not rs.EOF
     'Aqui você insere o algorítimo que fará a transferência do registro
     rs.MoveNext
Loop

Veja se é isso que está faltando.

Abraços e boa sorte.

Olá Julio, sim claro.. até ai eu havia entendido e sei que está faltando esses códigos, mas o meu problema está justamente nesse algoritimo não sei como colocar para complementar esse código:

Código:

rs.MoveFirst

Do While Not rs.EOF
    'Aqui você insere o algorítimo que fará a transferência do registro
    rs.MoveNext
Loop

Porque assim, a tabela que eu pegaria os dados vem desta parte:

Set rs = CurrentDb.OpenRecordset("SELECT CodImovel,CodProprietario,Endereco,N,Complemento FROM DetalhamentoCadastroImóveis WHERE CodImovel=" & Me.CódProprietario & "")

No caso a tabela é a "DetalhamentoCadastroImóveis"

E os campos que estou tentando enviar para o Word, que vem de um subformulário "DetalhamentoCadastroImóveisSub" são os valores dos campos
CodImovel e Endereco,N,Complemento "SE" forém iguais os campos CodImovel=" & Me.CódProprietario como previsto no código anterior.

Eu comprendi que precisa do "Do While Not rs.EOF" e do rs. MoveNext com o Loop para percorrer o código mas não sei como colocar esse algoritmo especifico do "rs" não sei se tenho que criar uma variável ou o que enfim essa é minha dúvida dai agora..

Desde já, obrigado !

Cria um segundo RecordSet com os dados da subConsulta e faz um loop dentro do outro.

Leonardo, boa noite!

É muito importante que você conheça a biblioteca ADO e DAO para você trabalhar com conexões à bancos de dados, extração, inclusão, manipulação de dados de um banco de dados.

Para o seu problema, vou fazer as alterações que julgo necessárias e você testa posteriormente.

Código:

Dim DocWord As Object
Dim db As Database, rs As Recordset

Set db = CurrentDb()

Set rs = db.OpenRecordset("SELECT CodImovel,CodProprietario,Endereco,N,Complemento FROM DetalhamentoCadastroImóveis WHERE CodImovel=" & Me.CódProprietario & "")

'Inicia o MS Word
Set oApp = CreateObject("Word.Application") 'Cria e abre o objeto Word
  
    With oApp
        'Torna o MS Word visível
        Visible = True
        'Torna o MS Word visível
        Visible = True
        'Abre o documento base
        .Documents.Open (CurrentProject.path & "\Contrato de Administração.doc")
        
        'Move cada campo para o indicador definido no documento
        .ActiveDocument.Bookmarks("Proprietario").Select
        .Selection.Text = Proprietario

        If Not IsNull(Me.RGLocad) Then
            .ActiveDocument.Bookmarks("RGLocad").Select
            .Selection.Text = Trim(CStr(Format(Me.RGLocad, "00\.000\.0000\-0")))
            Else
                   .ActiveDocument.Bookmarks("RGLocad").Select
                   .Selection.Text = ""
        End If

        .ActiveDocument.Bookmarks("CPFLocad").Select
        .Selection.Text = Trim(CStr(Format(CPFLocad, "000\.000\.000\-00")))
        .ActiveDocument.Bookmarks("NacionalidadeLocad").Select
        .Selection.Text = NacionalidadeLocad

        If Me.RegimedeCasamento = "Universal" Then
              .ActiveDocument.Bookmarks("EstadoCivilLocad").Select
              .Selection.Text = ""
              Else
                      .ActiveDocument.Bookmarks("EstadoCivilLocad").Select
                      .Selection.Text = EstadoCívilLocad
        End If

        .ActiveDocument.Bookmarks("NaturalidadeLocad").Select
        .Selection.Text = NaturalidadeLocad
        .ActiveDocument.Bookmarks("UFLocad").Select
        .Selection.Text = UFLocad
        .ActiveDocument.Bookmarks("ProfissãoLocad").Select
        .Selection.Text = ProfissãoLocad

        If Not IsNull(Me.Texto) Then
              .ActiveDocument.Bookmarks("Texto").Select
              .Selection.Text = Texto
              Else
                     .ActiveDocument.Bookmarks("Texto").Select
                     .Selection.Text = ""
        End If

        .ActiveDocument.Bookmarks("xx").Select
        .Selection.Text = PercentualComissão
        .ActiveDocument.Bookmarks("Extenso").Select
        .Selection.Text = PercentualExtenso
        
        rs.MoveFirst

        Do While Not rs.EOF
            'Move cada campo para o indicador definido no documento ref ao subformulário
            .ActiveDocument.Bookmarks("Cod").Select
            .Selection.Text = Trim(CStr(rs!CodImovel))
            .ActiveDocument.Bookmarks("Endereço").Select
            .Selection.Text = Trim(CStr(rs!Endereco))
            .ActiveDocument.Bookmarks("N").Select
            .Selection.Text = Trim(CStr(rs!N))
            If Not IsNull(Complemento) Then
                .ActiveDocument.Bookmarks("Complemento").Select
                .Selection.Text = Trim(CStr(rs!Complemento))
                Else
                      .Selection.Text = ""
            End If
            rs.MoveNext
        Loop

        'Salva o arquivo gerado
        .ActiveDocument.SaveAs ("C:\Users\Usuário\Desktop\Projeto Programa\Imóveis\ContratosGerados") & "\" & "ContratodeAdministração_Nº " & Replace(Me.Código, "/", "-") & ".doc"
        MsgBox "Documento WORD gerado com sucesso...", vbInformation
        'Fecha o documento
        .ActiveDocument.Close
        'Fecha o Word
        oApp.Quit

        If MsgBox("Deseja abrir o documento agora?", vbYesNo, "Excluir") = vbYes Then
            'Abre o documento
            'Winword em qualquer computador
                 Shell ("WINWORD" & " " & """C:\Users\Usuário\Desktop\Projeto Programa\Imóveis\ContratosGerados\" & "ContratodeAdministração_Nº " & Me.Código & ".doc"""), vbMaximizedFocus
                 Else
                       Cancel = True
        End If

        Set oApp = Nothing
        Set rs = Nothing
        rs.Close
        Set db = Nothing
        db.Close

    End With

Faça o teste e retorne para vermos se ocorreu algum erro de compilação.

Abraços e boa sorte.

Olá Julio, ele deu erro na seguinte parte " rs.MoveFirst" antes do "Do While Not rs.EOF"

"Erro em tempo de execução '3021':
Nenhum registro atual

Obrigado de qualquer forma !

Então ele não conseguiu abrir o recordset

Pois então não sei te dizer, o restante funciona só não funciona os registros do Subformulário na verdade ele só pega o 1 ... vamos dizer que tenha 3 ele só pega o 1...

Obrigado

O que é retornado se você criar uma consulta com o SQL gerado no código abaixo?

Código:

Set rs = db.OpenRecordset("SELECT CodImovel,CodProprietario,Endereco,N,Complemento FROM DetalhamentoCadastroImóveis WHERE CodImovel=" & Me.CódProprietario & "")

Ele pega o código do imóvel se for igual ao código do Proprietário os imóveis que correspondem a tal com o Endereço, Nº e Complemento.

Código:

ActiveDocument.Bookmarks("Cod").Select
            .Selection.Text = Trim(CStr(rs!CodImovel))
            .ActiveDocument.Bookmarks("Endereço").Select
            .Selection.Text = Trim(CStr(rs!Endereco))
            .ActiveDocument.Bookmarks("N").Select
            .Selection.Text = Trim(CStr(rs!N))
            If Not IsNull(Complemento) Then
                .ActiveDocument.Bookmarks("Complemento").Select
                .Selection.Text = Trim(CStr(rs!Complemento))
                Else
                      .Selection.Text = ""
            End If

Só que tipo digamos que o Código 01 tem 3 imóveis registrados
Só pega a 1 linha do registro da tabela, pelo filtro CódProprietario = CodImovel

Manda uma parte do sistema que dê pra gente testar

Leonardo, boa tarde!

O código tem que retorna todas as linhas cadastradas no subformulário. Se não o fizer, ou é porque o código do imóvel não foi localizado na tabela do subformulário, ou há apenas um registro, ou o código do imóvel que é usado como referência não é o adequado para isso.

Sem ter a sua base, ou pelo menos parte do projeto que envolva o seu problema, não tem como dar uma solução mais precisa.

O campo CodImovel é a chave primária do formulário principal, ou seja, ele é único para cada linha cadastrada? E na tabela DetalhamentoCadastroImóveis, essa coluna é a mesma que recebe o CodImovel mas que permite repetir para várias linhas?

Caso a resposta seja negativa para uma delas, então o problema pode estar aí.

Uma coisa que acabei de notar é que na condições WHERE você coloca a seguinte sintaxe: WHERE CodImovel=" & Me.CódProprietario & ""

Para mim, código de um imóvel é uma coisa, e código do proprietário é outra. Isto está certo mesmo? O código do proprietário é o código do imóvel?

Mais uma coisa. O código do imóvel é do tipo texto ou número na sua tabela?

Aguardo.

Vou verificar se consigo postar ao menos essa parte do sistema. Agradeço a todos por enquanto .

Olá boa tarde Julio Lustosa! Quanto tempo... bem havia deixado de lado essa parte do sistema pois não estava conseguindo resolver.. enfim troquei o código ali na referencia e funcionou estava errado mesmo o lance do campo.

Segue o código correto :

Código:

Dim DocWord As Object
Dim db As Database, rs As Recordset

Set db = CurrentDb()

Set rs = db.OpenRecordset("SELECT CodImovel,CodProprietario,Endereco,N,Complemento FROM DetalhamentoCadastroImóveis WHERE CodProprietario=" & Me.CódProprietario & "")
'Inicia o MS Word
Set oApp = CreateObject("Word.Application") 'Cria e abre o objeto Word
  
    With oApp
        'Torna o MS Word visível
        Visible = True
        'Torna o MS Word visível
        Visible = True
        'Abre o documento base
        .Documents.Open (CurrentProject.path & "\Contrato de Administração.doc")
          
        'Move cada campo para o indicador definido no documento
        .ActiveDocument.Bookmarks("Proprietario").Select
        .Selection.Text = Proprietario

        If Not IsNull(Me.RGLocad) Then
            .ActiveDocument.Bookmarks("RGLocad").Select
            .Selection.Text = Trim(CStr(Format(Me.RGLocad, "00\.000\.0000\-0")))
            Else
                   .ActiveDocument.Bookmarks("RGLocad").Select
                   .Selection.Text = ""
        End If

        .ActiveDocument.Bookmarks("CPFLocad").Select
        .Selection.Text = Trim(CStr(Format(CPFLocad, "000\.000\.000\-00")))
        .ActiveDocument.Bookmarks("NacionalidadeLocad").Select
        .Selection.Text = NacionalidadeLocad
        .ActiveDocument.Bookmarks("Prazo").Select
        .Selection.Text = Prazo
        .ActiveDocument.Bookmarks("PrazoExtenso").Select
        .Selection.Text = PrazoExtenso

        If Me.RegimedeCasamento = "Universal" Then
              .ActiveDocument.Bookmarks("EstadoCivilLocad").Select
              .Selection.Text = ""
              Else
                      .ActiveDocument.Bookmarks("EstadoCivilLocad").Select
                      .Selection.Text = EstadoCívilLocad
        End If

        .ActiveDocument.Bookmarks("NaturalidadeLocad").Select
        .Selection.Text = NaturalidadeLocad
        .ActiveDocument.Bookmarks("UFLocad").Select
        .Selection.Text = UFLocad
        .ActiveDocument.Bookmarks("ProfissãoLocad").Select
        .Selection.Text = ProfissãoLocad

        If Not IsNull(Me.Texto) Then
              .ActiveDocument.Bookmarks("Texto").Select
              .Selection.Text = Texto
              Else
                     .ActiveDocument.Bookmarks("Texto").Select
                     .Selection.Text = ""
        End If

        .ActiveDocument.Bookmarks("xx").Select
        .Selection.Text = PercentualComissão
        .ActiveDocument.Bookmarks("Extenso").Select
        .Selection.Text = PercentualExtenso
        .ActiveDocument.Bookmarks("DataContratoExtenso").Select
        .Selection.Text = DataContratoExtenso
        
        'rs.MoveFirst
          
        Do While Not rs.EOF
            'Move cada campo para o indicador definido no documento ref ao subformulário
            .ActiveDocument.Bookmarks("Cod").Select
            .Selection.Text = Trim(CStr(rs!CodImovel))
            .ActiveDocument.Bookmarks("Endereço").Select
            .Selection.Text = Trim(CStr(rs!Endereco))
            .ActiveDocument.Bookmarks("N").Select
            .Selection.Text = Trim(CStr(rs!N))
            If Not IsNull(Complemento) Then
                .ActiveDocument.Bookmarks("Complemento").Select
                .Selection.Text = Trim(CStr(rs!Complemento))
                Else
                      .Selection.Text = ""
            End If
            rs.MoveNext
        Loop

        'Salva o arquivo gerado
        .ActiveDocument.SaveAs ("C:\Users\Usuário\Desktop\Projeto Programa\Imóveis\ContratosGerados") & "\" & "ContratodeAdministração_Nº " & Replace(Me.Código, "/", "-") & ".doc"
        MsgBox "Contrato de Administração gerado com sucesso...", vbInformation
        'Fecha o documento
        .ActiveDocument.Close
        'Fecha o Word
        oApp.Quit

         rs.Close
         db.Close
        Set oApp = Nothing
        Set rs = Nothing
        Set db = Nothing      

    End With


    End Sub

Estou encerrando então este tópico ! Agradeço a todos !