Bonjour à tous,
J'ai créer un fichier en m'aidant de "DV_AjoutListe.xls" de Mr Jacques Boisgontier à l'adresse suivante:
DV_ajoutListe.xls
Mes compétences en VBA sont plus que limité pour compiler plusieur le codes afin de d'ajouter un élément qui n'appartient pas à une liste.
une exemple si dans ma liste "LTYPE" l'élément n'existe pas il est ajouter à liste "LTYPE", ensuite si dans ma liste "LGEO" l'élément n'existe pas il est ajouter et ainsi de suite ...
Je vous mets le fichier avec des annotations, ça seras peut être plus simple pour me comprendre !
Merci d'avance de vos lumières...
J'ai créer un fichier en m'aidant de "DV_AjoutListe.xls" de Mr Jacques Boisgontier à l'adresse suivante:
DV_ajoutListe.xls
Mes compétences en VBA sont plus que limité pour compiler plusieur le codes afin de d'ajouter un élément qui n'appartient pas à une liste.
une exemple si dans ma liste "LTYPE" l'élément n'existe pas il est ajouter à liste "LTYPE", ensuite si dans ma liste "LGEO" l'élément n'existe pas il est ajouter et ainsi de suite ...
Je vous mets le fichier avec des annotations, ça seras peut être plus simple pour me comprendre !
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Count = 1 Then
If Target <> "" Then
If IsError(Application.Match(Target.Value, [LTYPE], 0)) Then
If MsgBox("On ajoute?", vbYesNo) = vbYes Then
[LTYPE].End(xlDown).Offset(1, 0) = Target.Value
Sheets("DATA").[LTYPE].Sort key1:=Sheets("DATA").Range("B2")
Else
Application.Undo
End If
End If
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 And Target.Count = 1 Then
If Target <> "" Then
If IsError(Application.Match(Target.Value, [LGEO], 0)) Then
If MsgBox("On ajoute?", vbYesNo) = vbYes Then
[LGEO].End(xlDown).Offset(1, 0) = Target.Value
Sheets("DATA").[LGEO].Sort key1:=Sheets("DATA").Range("E2")
Else
Application.Undo
End If
End If
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 8 And Target.Count = 1 Then
If Target <> "" Then
If IsError(Application.Match(Target.Value, [LMAT], 0)) Then
If MsgBox("On ajoute?", vbYesNo) = vbYes Then
[LMAT].End(xlDown).Offset(1, 0) = Target.Value
Sheets("DATA").[LMAT].Sort key1:=Sheets("DATA").Range("H2")
Else
Application.Undo
End If
End If
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 10 And Target.Count = 1 Then
If Target <> "" Then
If IsError(Application.Match(Target.Value, [LCLASSE], 0)) Then
If MsgBox("On ajoute?", vbYesNo) = vbYes Then
[LCLASSE].End(xlDown).Offset(1, 0) = Target.Value
Sheets("DATA").[LCLASSE].Sort key1:=Sheets("DATA").Range("J2")
Else
Application.Undo
End If
End If
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 12 And Target.Count = 1 Then
If Target <> "" Then
If IsError(Application.Match(Target.Value, [LOUVERTURE], 0)) Then
If MsgBox("On ajoute?", vbYesNo) = vbYes Then
[LOUVERTURE].End(xlDown).Offset(1, 0) = Target.Value
Sheets("DATA").[LOUVERTURE].Sort key1:=Sheets("DATA").Range("L2")
Else
Application.Undo
End If
End If
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 15 And Target.Count = 1 Then
If Target <> "" Then
If IsError(Application.Match(Target.Value, [LPOSI], 0)) Then
If MsgBox("On ajoute?", vbYesNo) = vbYes Then
[LPOSI].End(xlDown).Offset(1, 0) = Target.Value
Sheets("DATA").[LPOSI].Sort key1:=Sheets("DATA").Range("O2")
Else
Application.Undo
End If
End If
End If
End If
End Sub
Merci d'avance de vos lumières...