[Resolvido]Alteração em subformulario

Bom dia .

Uso esse código no botão fechar que esta no form onde há um subform.

Mas quando ocorre alteração no subform não solicita se é para salvar ou não.

Preciso dessa mudança.

Dim X As Integer
If Me.Dirty Then
X = MsgBox("Houve adição ou alterações de registro, deseja salvar ?", vbYesNo + vbQuestion, "Atenção")
If X = vbNo Then
Me.Undo
End If
End If
DoCmd.Close

Mas quan

Olá...

Tente desta forma

Código:

If Me.Form.Dirty = True Or Me.Parent.Dirty = True Then 'Verifica se teve alguma alteração nos campos do formulário principar e do subformulário
        If MsgBox("O registro sofreu alteração, deseja Atualizar e fechar?", vbYesNo + vbInformation, "Atenção") = vbYes Then 'Exibe a mensagem
            DoCmd.RunCommand acCmdSaveRecord
            DoCmd.Close 'Fecha o form
        Else 'Caso o vbYesNo seja = vbNo
            Form.Undo 'Desfaz as alterações realizadas
            DoCmd.Close 'Fecha o formulário
        End If
    Else
        DoCmd.Close
    End If

Abraços

da erro na primeira linha

Erro em tempo de execução 2452.

ola pessoal so pra eu ficar por dentro das explicações do Celso Roberto

amigo,

utilizo essas rotinas no form e subform, nos seguintes eventos:

obs.: apenas substituir CritMsg por MsgBox

01 - Ao ocorrer Erro

Código:


Private Sub Form_Error(DataErr As Integer, Response As Integer)

Dim lin As String
lin = Chr$(13) & Chr$(10)


If DataErr = 2279 Then

            CritMsg "POR FAVOR! PREENCHA TODOS OS DÍGITOS DO CAMPO."
Else
                 
            Response = True
 
 
If DataErr = 3022 Then

        CritMsg "********** ITEM JÁ CADASTRADO **********" & lin _
                & lin & "VERIFIQUE NÚMERO E QUANTIDADE DO MATERIAL" _
           
            DoCmd.RunCommand acCmdUndo
       
            Me.MaterialNMM.SetFocus
   
Else
       
        Response = True


If DataErr = 3314 Then

        CritMsg "**********  VALORES INVÁLIDOS  **********" & lin _
        & lin & "NÚMERO, QUANTIDADE E TOTAL DO" & lin _
        & lin & "ITEM, DEVEM SER VALORES VÁLIDOS!" _


Else
                 
            Response = True


If DataErr = 3101 Then

        CritMsg "**********REGISTRO AINDA NÃO SALVO!*************" & lin _
        & lin & "PRESSIONE A TECLA ESC PARA CANCELAR"
Else

            Response = True
       
            Exit Sub

            End If

    End If

End If

End If


Response = False

End Sub



02 - Antes de Atualizar

Código:

Private Sub Form_BeforeUpdate(Cancel As Integer)

On Error GoTo Err_Form_BeforeUpDate
Const conErrNotVrNull = 94

Dim blnOK As Boolean
Dim strFav As String
Dim lin As String

lin = Chr$(13) & Chr$(10)
strFav = Format(FavNMM.Column(1), "00\.000\.000\/0000\-00")


If IsNull(DataNMM) Or IsNull(NMM) Or IsNull(CentroCusto) Or IsNull(FavNMM) Or IsNull(DocNMM) Then
       
        CritMsg "********* CAMPOS INVÁLIDOS *********" & lin _
        & lin & "DATA, NMM, LOCAL, NF E FORNECEDOR " & lin _
        & lin & "DEVEM CONTER VALORES VÁLIDOS!"
       
        'Desfaz a transação
        DoCmd.CancelEvent
       
        'Vai para o campo Número
        Me.DataNMM.SetFocus
       
        Exit Sub
               
         
Else


        blnOK = Confirmar("CONFIRMA A INCLUSÃO DO REGISTRO:" & lin _
                & lin & "DATA      : " & DataNMM & lin _
                & lin & "NMM        : " & NMM & lin _
                & lin & "LOCAL      : " & CentroCusto.Column(1) & lin _
                & lin & "NF        : " & DocNMM & lin _
                & lin & "FORNECEDOR : " & FavNMM.Column(2) & lin _
                & lin & "INSCRIÇÃO  : " & strFav & " ")
   
        If Not blnOK Then

   
        Cancel = True
                 
        End If
   
End If

Exit_Form_BeforeUpDate:

    Exit Sub
   
Err_Form_BeforeUpDate:

    If Err.Number = conErrNotVrNull Then
       
        CritMsg "REGISTRO COM VALORES INVÁLIDOS!"
       
       
        Me.DataNMM.SetFocus
       
        Cancel = True

    Else
       
        CritMsg Err.Description
   
    End If

Resume Exit_Form_BeforeUpDate

End Sub



A correção estava no relacionamento, refiz e deu certo.

Obrigado amigos.