[Resolvido]DoCmd.GoToRecord , , acNewRec x Subformulário

Bom dia

Em meu sistema tenho uma agenda de atendimentos, tudo estava funcionando perfeitamente, não sei o que houve, já depurei e não consegui "enxergar" o problema. O que ocorre é:

- Tenho várias abas na agenda, cada aba contém um ou mais subformulários (Conforme disponibilizo na imagem no link abaixo).

https://2img.net/r/ihimg/photo/my-images/198/0ij5.jpg/

O agendamento é feito através do sub formulário subfrm_AgendarHorários. Ao tentar incluir um novo registro após terminar o agendamento, clicando no botão salvar, a linha DoCmd.GoToRecord , , acNewRec - depurando, apresenta o valor 5, e o sistema persiste no registro incluso/editado. Uso o código abaixo no botão Salvar:

Código:


On Error GoTo TrataErro
    Dim strCamposNulos As String
    Dim intTotalNulos As Integer
If Not IsNull(Me.Id_Agenda) Then
    intTotalNulos = 0
    
    If IsNull(dtData) Then
        intTotalNulos = intTotalNulos + 1
        strCamposNulos = strCamposNulos & "Data para o Agendamento." & _
                        vbCrLf
    End If
    
    If IsNull(agHora) Then
        intTotalNulos = intTotalNulos + 1
        strCamposNulos = strCamposNulos & "Hora para o Agendamento." & _
                        vbCrLf
    End If
    
    If IsNull(Id_TipoCons) Then
        intTotalNulos = intTotalNulos + 1
        strCamposNulos = strCamposNulos & "Tipo do Agendamento." & _
                        vbCrLf
    End If
    
    If IsNull(Id_Paciente) Then
        intTotalNulos = intTotalNulos + 1
        strCamposNulos = strCamposNulos & "Paciente." & _
                        vbCrLf
    End If
    
    If IsNull(Id_ConvCons) Then
        intTotalNulos = intTotalNulos + 1
        strCamposNulos = strCamposNulos & "Convênio." & _
                        vbCrLf
    End If
    
  
    If intTotalNulos > 0 Then
    
        'Montando o texto da mensagem de aviso
        strCamposNulos = "Existem campos que precisam ser preenchidos:" & _
                        vbCrLf & vbLf & _
                        strCamposNulos
        
        'Exibindo mensagem para o usuário
        MsgBox strCamposNulos, vbCritical, "ATENÇÃO - Campo(s) de Preenchimento Obrigatório(s)!!!"
        DoCmd.CancelEvent
        'Me.Undo
        Me.dtData.SetFocus
    End If
        
    If intTotalNulos = 0 Then
        [Forms]![Frm_Agenda]![subfrm_AgendarHorários]![Id_Medico] = [Forms]![Frm_Agenda]![codmedparam]
        DoCmd.RunCommand acCmdSaveRecord
        MsgBox "Consulta Agendada / Alterada com Sucesso!", vbInformation, "Atenção"
        Me!Frm_Agenda.SetFocus
        Me!subfrm_AgendarHorários.Form!dtData.SetFocus
        DoCmd.GoToRecord , , acNewRec
        'Me!Frm_Agenda.SetFocus

        DoCmd.GoToRecord , , acNewRec
    End If
Else
    Me.dtData.SetFocus
End If
Exit_TrataErro:
    Forms!Frm_Agenda.Requery
    Exit Sub
TrataErro:
    Resume Next
    Exit Sub

End Sub



Uso o Access 2007. Alguém tem alguma dica do que possa fazer para corrigir tal problema?
Detalhe, este subformulário está vinculado a uma consulta com várias tabelas....


Att. Vinicius

vinicius.anna

Não quer postar no forum sem dados ?

Olá;

Sugestão;

Altere esta linha de acordo com esta;

Forms![Frm_Agenda]![subfrm_AgendarHorários].Form![Id_Medico]

Agora uma pergunta;

Tem duas vezes a instrução DoCmd.GoToRecord , , acNewRec, uma vez que este trecho está comentado 'Me!Frm_Agenda.SetFocus, qual é a razão ?

Assis,

Bom dia

Estou encaminhando parte da aplicação em anexo a este......

O agendamento é feito através do subfromulário subfrm_agendarHorários...., após preencher, ao clicar no botão Novo o sistema salva e deveria gerar um novo registro.....

Obrigado pela atenção.

Att. Vinicius

J Paulo

Boa tarde

Está comentando e está repetido porque acabei me esquecendo de eliminar isto...., li bastante documentações a respeito mas não consegui resolver. Testei vossa dica mas também não funcionou.

Obrigado.

Att. Vinicius

Teste

No Formulário ----subfrm_AgendarHorários

No botão de gravar --Disquete


Private Sub btNovo_Click()
On Error GoTo TrataErro
Dim strCamposNulos As String
Dim intTotalNulos As Integer
If Not IsNull(Me.Id_Agenda) Then
intTotalNulos = 0

If IsNull(dtData) Then
intTotalNulos = intTotalNulos + 1
strCamposNulos = strCamposNulos & "Data para o Agendamento." & _
vbCrLf
End If

If IsNull(agHora) Then
intTotalNulos = intTotalNulos + 1
strCamposNulos = strCamposNulos & "Hora para o Agendamento." & _
vbCrLf
End If

If IsNull(Id_TipoCons) Then
intTotalNulos = intTotalNulos + 1
strCamposNulos = strCamposNulos & "Tipo do Agendamento." & _
vbCrLf
End If

If IsNull(Id_Paciente) Then
intTotalNulos = intTotalNulos + 1
strCamposNulos = strCamposNulos & "Paciente." & _
vbCrLf
End If

If IsNull(Id_ConvCons) Then
intTotalNulos = intTotalNulos + 1
strCamposNulos = strCamposNulos & "Convênio." & _
vbCrLf
End If


If intTotalNulos > 0 Then

'Montando o texto da mensagem de aviso
strCamposNulos = "Existem campos que precisam ser preenchidos:" & _
vbCrLf & vbLf & _
strCamposNulos

'Exibindo mensagem para o usuário
MsgBox strCamposNulos, vbCritical, "ATENÇÃO - Campo(s) de Preenchimento Obrigatório(s)!!!"
DoCmd.CancelEvent
'Me.Undo
Me.dtData.SetFocus
End If

If intTotalNulos = 0 Then
[Forms]![Frm_Agenda]![subfrm_AgendarHorários]![Id_Medico] = [Forms]![Frm_Agenda]![codmedparam]
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Consulta Agendada / Alterada com Sucesso!", vbInformation, "Atenção"

DoCmd.GoToRecord , , acNewRec
Forms!Frm_Agenda.Requery

Me!subfrm_AgendarHorários.Form!dtData.SetFocus
Me!Frm_Agenda.SetFocus
Me!Frm_Agenda.SetFocus

End If
Else
Me.dtData.SetFocus
End If



Exit_TrataErro:
Forms!Frm_Agenda.Requery
Exit Sub
TrataErro:
Resume Next
Exit Sub

End Sub

Boa tarde Assis,

Obrigado pela atenção, mas acabou não dando certo.....

Fiz o ajuste aqui, na primeira inclusão de um novo agendamento, funciona perfeitamente, ao incluir um segundo agendamento acaba não funcionando mais...... não consegui compreender.......

Não sei se está relacionado a uma função que inclui no subfrm_agendarhorários para identificar a posição absoluta do registro - ExibeRec

Tem mais alguma dica?

Muito obrigado pela atenção

Att. Vinicius

Aqui gravo as que quizer seguidas

Bom dia

Assis,

Muito obrigado,

Problema resolvido

Em virtude de algumas verificações que faço na agenda precisei criar uma função para validar, gravar e adicionar um novo registro, mas apenas consegui isto com sua valiosa dica.

Muito obrigado.

Att. Vinicius