MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

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

    Leonardo Favale
    Leonardo Favale
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 116
    Registrado : 05/04/2018

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

    Mensagem  Leonardo Favale em 3/6/2019, 17:11

    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


    Última edição por Leonardo Favale em 20/11/2019, 12:21, editado 1 vez(es)
    avatar
    renpv
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 323
    Registrado : 12/01/2015

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

    Mensagem  renpv em 9/6/2019, 21:52

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

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 116
    Registrado : 05/04/2018

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

    Mensagem  Leonardo Favale em 24/6/2019, 14:45

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

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2453
    Registrado : 22/11/2016

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

    Mensagem  DamascenoJr. em 24/6/2019, 16:01

    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


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2453
    Registrado : 22/11/2016

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

    Mensagem  DamascenoJr. em 24/6/2019, 16:04

    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


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    Leonardo Favale
    Leonardo Favale
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 116
    Registrado : 05/04/2018

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

    Mensagem  Leonardo Favale em 25/6/2019, 15:39

    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 !
    Leonardo Favale
    Leonardo Favale
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 116
    Registrado : 05/04/2018

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

    Mensagem  Leonardo Favale em 25/6/2019, 20:08

    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 !

    Julio Lustosa
    Julio Lustosa
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 203
    Registrado : 23/02/2011

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

    Mensagem  Julio Lustosa em 25/6/2019, 20:27

    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.
    Leonardo Favale
    Leonardo Favale
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 116
    Registrado : 05/04/2018

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

    Mensagem  Leonardo Favale em 26/6/2019, 13:14

    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 !
    avatar
    renpv
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 323
    Registrado : 12/01/2015

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

    Mensagem  renpv em 26/6/2019, 23:25

    Cria um segundo RecordSet com os dados da subConsulta e faz um loop dentro do outro.
    Julio Lustosa
    Julio Lustosa
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 203
    Registrado : 23/02/2011

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

    Mensagem  Julio Lustosa em 27/6/2019, 02:50

    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.
    Leonardo Favale
    Leonardo Favale
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 116
    Registrado : 05/04/2018

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

    Mensagem  Leonardo Favale em 28/6/2019, 15:54

    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 !
    avatar
    renpv
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 323
    Registrado : 12/01/2015

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

    Mensagem  renpv em 28/6/2019, 19:01

    Então ele não conseguiu abrir o recordset
    Leonardo Favale
    Leonardo Favale
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 116
    Registrado : 05/04/2018

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

    Mensagem  Leonardo Favale em 28/6/2019, 19:52

    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
    avatar
    renpv
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 323
    Registrado : 12/01/2015

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

    Mensagem  renpv em 28/6/2019, 20:37

    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 & "")
    Leonardo Favale
    Leonardo Favale
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 116
    Registrado : 05/04/2018

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

    Mensagem  Leonardo Favale em 1/7/2019, 13:14

    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
    avatar
    renpv
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 323
    Registrado : 12/01/2015

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

    Mensagem  renpv em 1/7/2019, 14:03

    Manda uma parte do sistema que dê pra gente testar
    Julio Lustosa
    Julio Lustosa
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 203
    Registrado : 23/02/2011

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

    Mensagem  Julio Lustosa em 1/7/2019, 18:33

    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í.
    Julio Lustosa
    Julio Lustosa
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 203
    Registrado : 23/02/2011

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

    Mensagem  Julio Lustosa em 1/7/2019, 18:38

    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.
    Leonardo Favale
    Leonardo Favale
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 116
    Registrado : 05/04/2018

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

    Mensagem  Leonardo Favale em 3/7/2019, 20:28

    Vou verificar se consigo postar ao menos essa parte do sistema. Agradeço a todos por enquanto .
    Leonardo Favale
    Leonardo Favale
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 116
    Registrado : 05/04/2018

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

    Mensagem  Leonardo Favale em 18/11/2019, 19:48

    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 !

      Data/hora atual: 28/11/2020, 02:00