Option Explicit
Dim K As Variant
Dim Ligne As Integer
Dim L As Variant
Dim LigSaisie As Variant
Dim adrSaisie As Variant
Dim Cel As Range
Dim F1 As Worksheet
Dim Lign As Long
Dim OldType As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
'**************************************************************************************************************
'**************************************************************************************************************
'VERIFICATION DOUBLONS
'**************************************************************************************************************
'**************************************************************************************************************
If Target.Column = 1 And Target.Row > 2 And Target.Count = 1 Then
LigSaisie = Target.Row
For L = 2 To Application.CountA([A:A])
If Cells(L, 1) = Cells(LigSaisie, 1) And L <> LigSaisie Then
MsgBox "Doublon avec ligne " & L
Application.EnableEvents = False
Application.Undo
Cells(LigSaisie, 1).Resize(, 39).ClearContents
Application.EnableEvents = True
End If
Next L
End If
'*************************************************************************************************************
'*************************************************************************************************************
'VERIFICATION RECOPIE TYPE SELON N°ECHANTILLON
'*************************************************************************************************************
'*************************************************************************************************************
Set F1 = Sheets("DONNEES - RESULTATS")
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
With Sheets("C13")
'Vérifie si une modif en colonne C
If Not Intersect(Range("C2:C" & Rows.Count), Target) Is Nothing Then
'Arrêt des événements
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
F1.Unprotect
If Range("A" & Target.Row) <> "" Then 'Un numéro d'échantillon
'recherche dans la 1ère page
Set Cel = F1.Columns("A").Find(what:=Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then 'On l'a trouvé
OldType = Cel.Offset(0, 2)
If OldType = "" Then OldType = "(Aucune valeur) "
If OldType <> Target Then
'Pose la question du remplacement
If MsgBox("Le précédent type défini pour l'échantillon " & Range("A" & Target.Row) & " est égal à " & vbCr & vbCr & vbTab & vbTab & OldType & vbCr & vbCr & _
" Voulez vous remplacer celui-ci ?" & vbCr & vbCr & vbTab & vbTab & Target, vbQuestion + vbYesNo, "Nouvelle valeur ") = vbYes Then
' Réponse on le remplace
Cel.Offset(0, 2) = Target
Else
' Réponse on le modifie
Target = Cel.Offset(0, 2)
End If
End If
Else
' Le numéro d'échantillon n'existe pa
Lign = F1.Range("A" & Rows.Count).End(xlUp).Row + 1
F1.Range("A" & Lign) = Range("A" & Target.Row)
F1.Range("C" & Lign) = Target
End If
Else
' Pas de numéro d'échantillon
Target = ""
MsgBox "Veuillez d'abord saisir un numéro d'échantillon"
End If
Application.EnableEvents = True ' Réactive les événements
F1.Protect
End If
End With
'***********************************************************************************************************
'***********************************************************************************************************
'VERIFICATION FORMAT NUMERO ECHANTILLON
'***********************************************************************************************************
'***********************************************************************************************************
Set K = Sheets("C13")
Ligne = Range("A65536").End(xlUp).Row
'permet de sortir de la procédure si plus d'une cellule est sélectionnée
'(sinon la suite de la macro renvoie un message d'erreur)
If Target.Count = 1 Then
On Error GoTo GESTERR
Application.ScreenUpdating = False 'désactive maj ecran
If Not Application.Intersect(Target, Cells(Ligne, 1)) Is Nothing Then
If Target <> "" Then
For Each Target In Range(K.[A2], K.[A65536].End(xlUp))
Application.EnableEvents = False 'désactive les événements
If Target.Value <> "" Then
Call Verif_Format(Target.Value)
If Verif_Format(Target.Value) = False Then
MsgBox ("Veuillez corriger le format d'identification de l'échantillon." & vbNewLine & "Formats possibles: ####-#### (#) / T##[A-Z) / ####-#### [A-Z].")
Target = ""
Target.Select
End If
End If
Application.EnableEvents = True 'réactive les événements
Next Target
End If
End If
Application.ScreenUpdating = True 'reactive maj ecran
End If
'rétabli le fonctionnement d'Excel avant de quitter
GESTERR:
Application.EnableEvents = True
Exit Sub
End Sub