1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
| Private Sub LTA_Libre_Click()
Dim SQL As String
Dim SQL1 As String
utilisateur = Environ("username") 'Permet d'obtenir le nom de la session windows en cour
REF = seleccomp
If IsNull(REF) Then
MsgBox "choisir compagnie" & vbCr & vbLf & "Merci."
Exit Sub
End If
Set ctlSource = Me!seleccomp
For intCurrentRow = 0 To ctlSource.ListCount - 1
If ctlSource.Selected(intCurrentRow) Then
nomca = ctlSource.Column(1, intCurrentRow)
End If
Next intCurrentRow
DSSR = CStr(InputBox("Saisie du numéro de dossier?"))
If "a" & DSSR = "a" Then DSSR = Null
If Not IsNull(DSSR) Then
DoCmd.SetWarnings False 'POUR EVITER LES Questions
'Ouvrir_Base_Exclusif()
Dim Bd As Database
'Pour reserver la base mdb en exclusif mettre true sinon mettre false
On Error GoTo gesterreur
attenteDB:
Set Bd = DBEngine(0).OpenDatabase("P:/Verrou1.mdb", True) 'ouverture de la base Verrou en exclusif
SQLDSSR = "SELECT LTA.* FROM LTA WHERE (((LTA.JFH_FILE)='" & DSSR & "')) ;"
Set edDSSR = CurrentDb.OpenRecordset(SQLDSSR, dbOpenDynaset)
If Not edDSSR.EOF Then
edDSSR.MoveFirst
Set Bd = Nothing
MsgBox "Le numéro de dossier existe dèja pour le numéro LTA : " & edDSSR!LTA
edDSSR.Close
Set edDSSR = Nothing
Exit Sub
End If
edDSSR.Close
Set edDSSR = Nothing
sqlta = "SELECT LTA_AVAILABLE.* FROM LTA_AVAILABLE WHERE (((LTA_AVAILABLE.IATA)=" & REF & " )) AND ((LTA_AVAILABLE.Date) Is Null) AND ((LTA_AVAILABLE.Comment) Is Null);"
Set edlta = CurrentDb.OpenRecordset(sqlta, dbOpenDynaset)
If edlta.EOF Then
Set Bd = Nothing
MsgBox "Il n'y a plus de LTA libre" & vbCr & vbLf & "en demander à la compagnie" & vbCr & vbLf & "Merci."
Exit Sub
End If
edlta.MoveLast
monreste = edlta.RecordCount - 1
edlta.MoveFirst
Save = edlta!LTA
Set ed = CurrentDb.OpenRecordset("LTA", dbOpenDynaset)
With ed
.AddNew
!IATA = nomca
!LTA = Save
!COMPANY = REF
!Date = Date
!User = utilisateur
!JFH_FILE = DSSR
.Update
.Close
End With
Refresh
With edlta
.MoveFirst
.Delete
.Close
End With
Set Bd = Nothing
MsgBox "Il reste: " & monreste & " LTA disponibles"
SQL = "SELECT LTA.* FROM LTA WHERE (((LTA.IATA)=" & REF & ")) AND (((LTA.LTA)=" & Save & ")) ;"
Me.SousFormulaire.Form.RecordSource = SQL
Me.Refresh
End If
DoCmd.SetWarnings True
Exit Sub
gesterreur:
If err.Number = 3045 Or err.Number = 3049 Then
choix = MsgBox(err.Number & vbCrLf & err.Description & vbCrLf & "On insiste?", vbYesNo)
err.Clear
If choix = vbNo Then
DoCmd.SetWarnings True
Exit Sub
End If
Resume attenteDB
Else
MsgBox err.Number & vbCrLf & err.Description
err.Clear
Set Bd = Nothing
DoCmd.SetWarnings True
End If
End Sub |
Partager