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
| Private Sub cmd_dupliquer_Click()
Dim a As String
a = InputBox("Noter l'identifiant de la nouvelle unité, Dupliquer " & Me.Unité)
Dim rstProtocole As DAO.Recordset, rstProtocole2 As DAO.Recordset
Dim Db As DAO.Database, fld As DAO.Field
Dim sql As String
Dim id As String
Set Db = CurrentDb
'Ouvre le recordset où sera prélevé le protocole
Set rstProtocole = Db.OpenRecordset("SELECT Unité,désignation,[Type d'unité],Photo,Lieu,Nompictorisque1,pictorisque1,Nompictorisque2,pictorisque2,Nompictorisque3,pictorisque3,Nompictorisque4,pictorisque4,Nompictorisque5,pictorisque5,Nompictorisque6,pictorisque6,Nompictorisque7,pictorisque7,Nompictorisque8,pictorisque8,nompictoepi1,pictoEPI1,nompictoepi2,pictoEPI2,nompictoepi3,pictoEPI3,nompictoepi4,pictoEPI4,nompictoepi5,pictoEPI5,nompictoepi6,pictoEPI6,nompictoepi7,pictoEPI7,nompictoepi8,pictoEPI8 FROM [Unité de travail] WHERE unité='" & Me.Unité & "'")
'Verifie que le protocole 1 existe
If rstProtocole.EOF Then Exit Sub
'ouvre le recordset où sera ajouté le protocole
Set rstProtocole2 = Db.OpenRecordset("Unité de travail")
'Duplique le protocole
With rstProtocole2
.AddNew
'duplique les champs
For Each fld In rstProtocole.Fields
.Fields(fld.Name) = fld.Value
Next
.Fields("Unité") = a
id = .Fields("Unité")
.Update
'se positionne sur l'enregistrement ajouté
End With
'Duplique les lignes
sql = "insert into [identification du risque] (Unité,désignation,[Date de création],[Date de la dernière évaluation],[Danger identifié],[Situation à risque],[Mesures préventives existantes]) SELECT '" & _
id & "', désignation,[Date de création],[Date de la dernière évaluation],[Danger identifié],[Situation à risque],[Mesures préventives existantes] FROM [identification du risque] WHERE unité='" & Me.Unité & "'"
Db.Execute sql
MsgBox ("ATTENTION LES RISQUES COPIERS LORSQUE L'UNITE EST DUPLIQUE NE SONT PAS EVALUE")
End Sub |
Partager