تفضل ------->>>>>>
On Error Resume Next
Me.Refresh
Dim i
i = Me.IDED
If MsgBox("هل تريد إرجاع جهاز وطباعة الإستمارة؟", _
vbCritical + vbYesNo, _
"") = vbNo Then
Exit Sub
Else
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO EMPDEV_ARCHIVES ( IDED, IDE, IDD, DATEG, STATUS, SystemS, NOTES2, DATER, RECEIPT, NOTES, IDD1, IDD2, Choix ) " & _
" SELECT EMPDEV.IDED, EMPDEV.IDE, EMPDEV.IDD, EMPDEV.DATEG, EMPDEV.STATUS, EMPDEV.SystemS, EMPDEV.NOTES2, EMPDEV.DATER, EMPDEV.RECEIPT, EMPDEV.NOTES, EMPDEV.IDD1, EMPDEV.IDD2, EMPDEV.Choix " & _
" FROM EMPDEV " & _
" WHERE (((EMPDEV.Choix)=True));"
DoCmd.OutputTo acOutputReport, "EMPDEVMENU", acFormatPDF, strPathAndfile, True
DoCmd.RunSQL "DELETE EMPDEV.Choix, EMPDEV.* " & _
" FROM EMPDEV " & _
" WHERE (((EMPDEV.Choix)=True));"
DoCmd.SetWarnings True
End If
Me.Requery
'Me.Visible = False
DoCmd.OpenReport "SCDEV_ARCHIVES", acViewPreview ', , "[IDED]=Forms![EMPDEVMENU]![IDED]", acWindowNormal
DoCmd.Close acForm, Me.Name, acSaveNo
'DoCmd.OpenForm "mod1", , , "mcod=" & i