[Resolvido]Rotina em VBA, não lê mais que 3 linhas no sub-formulário.

Prezados bom dia.

Graças ao Noobezinho, o mesmo  me cedeu o código abaixo:

Código:

Dim strHist As String
 Dim I As Integer
 Dim rs As DAO.Recordset

    Set rs = Me.DetReceita_subformulário.Form.RecordsetClone    'Clono o recorset do subform
    rs.MoveFirst    'Para evitar erros, posiciono o ponteiro do recordset no primeiro registro
    'strHist = Me.DataConsulta & vbCrLf    'Começo a montar o histórico de adição informando a data de cadastro
    I = 0
    For I = 0 To rs.RecordCount   'Percorro todos os registro do recordset do subformu
        'Continuo montando o histórico, agora com os dados do RecordsetClone do subformulário observando as devidas concatenações
        strHist = strHist & "-Uso: " & rs!Uso & "      - Medicamento: " & rs!Medicamento & "       - Posologia:  " & rs!Posologia & vbCrLf
        rs.MoveNext
        I = I + 1
    Next

    rs.Close 'Fecho a conexao com recordset
    Set rs = Nothing 'apagado o rs da memória
  

Dim db1 As Database, rs1 As DAO.Recordset
Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("Caes", dbOpenDynaset)
rs1.FindFirst "idcaes  = " & Forms!receituario!Idcaesrec
With rs1
'.Seek "=", Me.Idcaesrec comentei essa linha e deu resultado esperado
.Edit
 If IsNull(!HistRec) Or !HistRec = " " Then
   !HistRec = !HistRec & vbCrLf & Me.DataConsulta & vbCrLf & Me.Diagnostico & vbCrLf & Me.Temp & "º   " & Me.PesoAnimal & "Kgs   " & vbCrLf & strHist
 Else
   !HistRec = !HistRec & vbCrLf & "*********************************************************************************************" & vbCrLf & "Data Consulta: " & Me.DataConsulta & vbCrLf & "Diagnóstico: " & Me.Diagnostico & vbCrLf & "Temp: " & Me.Temp & "º  " & "Peso: " & Me.PesoAnimal & "Kgs   " & vbCrLf & strHist
 End If
.Update

End With

Espero que o Noob possa ver e me dar uma luz, pois estou a necessitar.

O que ocorre, a rotina acima, lê apenas 3 linhas do sub-formulário e não mais que isso.   Há momentos que há mais de 3...4....5...até 7 linhas no sub-formulário.



Abraços

Bom......quem quer peixe, tem que aprender a pescar, tem que aprender a colocar a minhoca no anzol.

Estudando um pouco, resolvi da seguinte maneira:

Código:

Private Sub Carteira_Click()
'pendencia de cliente

'aqui inicio a exportação para o historico de caixa da tabela proprietarios
 Dim strHist As String
 Dim rs As DAO.Recordset

    Set rs = Me.SFrmCaixa.Form.RecordsetClone    'Clono o recorset do subform
    rs.MoveFirst    'Para evitar erros, posiciono o ponteiro do recordset no primeiro registro
    Do Until rs.EOF
    strHist = strHist & "Proc/Med: " & rs!Servico & "      -- Valor R$: " & rs!Custo & "      -- Qtd:  " & rs!Qtd & "    --Valor Total R$: " & rs!Tcusto & vbCrLf
    rs.MoveNext
    Loop
    rs.Close 'Fecho a conexao com recordset
    Set rs = Nothing 'apagado o rs da memória
   
Dim db1 As Database, rs1 As DAO.Recordset
Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("proprietarios", dbOpenDynaset)
rs1.FindFirst "idprop  = " & Forms!frmcaixa!IdProp
With rs1
.Edit
 If IsNull(!Histcaixa) Or !Histcaixa = " " Then
  !Histcaixa = !Histcaixa & vbCrLf & "*-*-*-*-*-*-*-*-*-*-*-*-* Carteira *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-"
  !Histcaixa = !Histcaixa & vbCrLf & "DATA: " & Me.DataPagamento & vbCrLf & _
                                      "Mascote:  " & Me.Animal & vbCrLf & _
                                      "Desc.:  " & FormatCurrency(Me.Descontos) & " Total pago:  " & FormatCurrency(Me.Valor) & vbCrLf & strHist
                                     
                                     
                                     
 Else
 !Histcaixa = !Histcaixa & vbCrLf & "*-*-*-*-*-*-*-*-*-*-*-*-* Carteira *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-"
 !Histcaixa = !Histcaixa & vbCrLf & "DATA: " & Me.DataPagamento & vbCrLf & _
                                      "Mascote:  " & Me.Animal & vbCrLf & _
                                      "Desc.:  " & FormatCurrency(Me.Descontos) & " Total pago:  " & FormatCurrency(Me.Valor) & vbCrLf & strHist
                                   

 End If
.Update

End With

End sub


Agora pode-se colocar mais que 3,4,5,.....medicamentos ou procedimentos que os mesmos irão para o campo memorando da tabela.

É isso ai Silvio!

Quando solucionamos por nós mesmo, é uma benção !!

Boa sorte !

Noob