Liste déroulante tableau excel vba

Signaler
Messages postés
28
Date d'inscription
vendredi 13 avril 2012
Statut
Membre
Dernière intervention
9 mai 2012
-
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
-
Bonjour,

J'ai un projet de stage à faire, j'ai repris un code d'un ancien stagiaires et je tombe sur quelques petits problemes. On m'a demander d'ajouter des tableau avec des listes déroulantes sur un page qui en contenait deja 10 et je doit en rajouter 5 le probleme c'est que je n'arrive absoluement pas a faire sa car des que j'essaye j'ai des probleme partout. je vous met le code du module et de la feuilles en question.

Module Paramères:

Sub AjoutLigneA()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneA")
k = Range("LigneA").Row
j = i - k

Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown
Range("E" & i + 1).FormulaR1C1 = "=IF(R[-1]C[-3]="""",0,50)"
Range("F" & i & ":G" & i).AutoFill Destination:=Range("F" & i & ":G" & i + 1), Type:=xlFillDefault
Sheets("paramètres").Unprotect
Range("A" & i + 1).Borders(xlEdgeTop).LineStyle = xlNone
With Range("A" & i + 1).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("D" & i + 1).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ThisWorkbook.Names.Add Name:="CriA" & j + 1, RefersToR1C1:="=Paramètres!R" & k & "C2:R" & i + 1 & "C4"
Range("CodeA").FormulaR1C1 = "=" & j + 1 & "-COUNTIF(R[1]C[1]:R[" & j + 1 & "]C[1],"""")"

Range("LigneA") = i + 1
Range("LigneB") = Range("LigneB") + 1
Range("LigneC") = Range("LigneC") + 1
Range("LigneD") = Range("LigneD") + 1
Range("LigneE") = Range("LigneE") + 1
Range("LigneF") = Range("LigneF") + 1
Range("LigneG") = Range("LigneG") + 1
Range("LigneH") = Range("LigneH") + 1
Range("LigneI") = Range("LigneI") + 1
Range("LigneJ") = Range("LigneJ") + 1

Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells

End Sub

Sub SupprimeLigneA()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneA")
k = Range("LigneA").Row
j = i - k

If i = k + 1 Then
MsgBox ("Vous ne pouvez pas supprimer cette ligne.")
GoTo fin
ElseIf Range("B" & i) <> "" Then
a = MsgBox("Attention! La ligne que vous souhaitez supprimer n'est pas vide. Voulez-vous continuer?", vbOKCancel)
If a = vbOK Then
GoTo Supprligne
Else: GoTo fin
End If
Else
Supprligne:
Range("CodeA").FormulaR1C1 = "=" & j - 1 & "-COUNTIF(R[1]C[1]:R[" & j - 1 & "]C[1],"""")"
ThisWorkbook.Names("CriA" & j).Delete
Rows(i & ":" & i).Delete Shift:=xlUp
With Range("A" & i - 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("LigneA") = i - 1
Range("LigneB") = Range("LigneB") - 1
Range("LigneC") = Range("LigneC") - 1
Range("LigneD") = Range("LigneD") - 1
Range("LigneE") = Range("LigneE") - 1
Range("LigneF") = Range("LigneF") - 1
Range("LigneG") = Range("LigneG") - 1
Range("LigneH") = Range("LigneH") - 1
Range("LigneI") = Range("LigneI") - 1
Range("LigneJ") = Range("LigneJ") - 1

End If

fin:
Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub AjoutLigneB()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneB")
k = Range("LigneB").Row
j = i - k

Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown
Range("E" & i + 1).FormulaR1C1 = "=IF(R[-1]C[-3]="""",0,50)"
Range("F" & i & ":G" & i).AutoFill Destination:=Range("F" & i & ":G" & i + 1), Type:=xlFillDefault
Sheets("paramètres").Unprotect
Range("A" & i + 1).Borders(xlEdgeTop).LineStyle = xlNone
With Range("A" & i + 1).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("D" & i + 1).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ThisWorkbook.Names.Add Name:="CriB" & j + 1, RefersToR1C1:="=Paramètres!R" & k & "C2:R" & i + 1 & "C4"
Range("CodeB").FormulaR1C1 = "=" & j + 1 & "-COUNTIF(R[1]C[1]:R[" & j + 1 & "]C[1],"""")"

Range("LigneB") = i + 1
Range("LigneC") = Range("LigneC") + 1
Range("LigneD") = Range("LigneD") + 1
Range("LigneE") = Range("LigneE") + 1
Range("LigneF") = Range("LigneF") + 1
Range("LigneG") = Range("LigneG") + 1
Range("LigneH") = Range("LigneH") + 1
Range("LigneI") = Range("LigneI") + 1
Range("LigneJ") = Range("LigneJ") + 1

Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub SupprimeLigneB()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneB")
k = Range("LigneB").Row
j = i - k

If i = k + 1 Then
MsgBox ("Vous ne pouvez pas supprimer cette ligne.")
GoTo fin
ElseIf Range("B" & i) <> "" Then
a = MsgBox("Attention! La ligne que vous souhaitez supprimer n'est pas vide. Voulez-vous continuer?", vbOKCancel)
If a = vbOK Then
GoTo Supprligne
Else: GoTo fin
End If
Else
Supprligne:
Range("CodeB").FormulaR1C1 = "=" & j - 1 & "-COUNTIF(R[1]C[1]:R[" & j - 1 & "]C[1],"""")"
ThisWorkbook.Names("CriB" & j).Delete
Rows(i & ":" & i).Delete Shift:=xlUp
With Range("A" & i - 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("LigneB") = i - 1
Range("LigneC") = Range("LigneC") - 1
Range("LigneD") = Range("LigneD") - 1
Range("LigneE") = Range("LigneE") - 1
Range("LigneF") = Range("LigneF") - 1
Range("LigneG") = Range("LigneG") - 1
Range("LigneH") = Range("LigneH") - 1
Range("LigneI") = Range("LigneI") - 1
Range("LigneJ") = Range("LigneJ") - 1

End If

fin:
Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub AjoutLigneC()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneC")
k = Range("LigneC").Row
j = i - k

Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown
Range("E" & i + 1).FormulaR1C1 = "=IF(R[-1]C[-3]="""",0,50)"
Range("F" & i & ":G" & i).AutoFill Destination:=Range("F" & i & ":G" & i + 1), Type:=xlFillDefault
Sheets("paramètres").Unprotect
Range("A" & i + 1).Borders(xlEdgeTop).LineStyle = xlNone
With Range("A" & i + 1).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("D" & i + 1).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ThisWorkbook.Names.Add Name:="CriC" & j + 1, RefersToR1C1:="=Paramètres!R" & k & "C2:R" & i + 1 & "C4"
Range("CodeC").FormulaR1C1 = "=" & j + 1 & "-COUNTIF(R[1]C[1]:R[" & j + 1 & "]C[1],"""")"

Range("LigneC") = i + 1
Range("LigneD") = Range("LigneD") + 1
Range("LigneE") = Range("LigneE") + 1
Range("LigneF") = Range("LigneF") + 1
Range("LigneG") = Range("LigneG") + 1
Range("LigneH") = Range("LigneH") + 1
Range("LigneI") = Range("LigneI") + 1
Range("LigneJ") = Range("LigneJ") + 1

Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub SupprimeLigneC()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneC")
k = Range("LigneC").Row
j = i - k

If i = k + 1 Then
MsgBox ("Vous ne pouvez pas supprimer cette ligne.")
GoTo fin
ElseIf Range("B" & i) <> "" Then
a = MsgBox("Attention! La ligne que vous souhaitez supprimer n'est pas vide. Voulez-vous continuer?", vbOKCancel)
If a = vbOK Then
GoTo Supprligne
Else: GoTo fin
End If
Else
Supprligne:
Range("CodeC").FormulaR1C1 = "=" & j - 1 & "-COUNTIF(R[1]C[1]:R[" & j - 1 & "]C[1],"""")"
ThisWorkbook.Names("CriC" & j).Delete
Rows(i & ":" & i).Delete Shift:=xlUp
With Range("A" & i - 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Range("LigneC") = i - 1
Range("LigneD") = Range("LigneD") - 1
Range("LigneE") = Range("LigneE") - 1
Range("LigneF") = Range("LigneF") - 1
Range("LigneG") = Range("LigneG") - 1
Range("LigneH") = Range("LigneH") - 1
Range("LigneI") = Range("LigneI") - 1
Range("LigneJ") = Range("LigneJ") - 1

End If

fin:
Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub AjoutLigneD()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneD")
k = Range("LigneD").Row
j = i - k

Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown
Range("E" & i + 1).FormulaR1C1 = "=IF(R[-1]C[-3]="""",0,50)"
Range("F" & i & ":G" & i).AutoFill Destination:=Range("F" & i & ":G" & i + 1), Type:=xlFillDefault
Sheets("paramètres").Unprotect
Range("A" & i + 1).Borders(xlEdgeTop).LineStyle = xlNone
With Range("A" & i + 1).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("D" & i + 1).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ThisWorkbook.Names.Add Name:="CriD" & j + 1, RefersToR1C1:="=Paramètres!R" & k & "C2:R" & i + 1 & "C4"
Range("CodeD").FormulaR1C1 = "=" & j + 1 & "-COUNTIF(R[1]C[1]:R[" & j + 1 & "]C[1],"""")"

Range("LigneD") = i + 1
Range("LigneE") = Range("LigneE") + 1
Range("LigneF") = Range("LigneF") + 1
Range("LigneG") = Range("LigneG") + 1
Range("LigneH") = Range("LigneH") + 1
Range("LigneI") = Range("LigneI") + 1
Range("LigneJ") = Range("LigneJ") + 1

Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub SupprimeLigneD()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneD")
k = Range("LigneD").Row
j = i - k

If i = k + 1 Then
MsgBox ("Vous ne pouvez pas supprimer cette ligne.")
GoTo fin
ElseIf Range("B" & i) <> "" Then
a = MsgBox("Attention! La ligne que vous souhaitez supprimer n'est pas vide. Voulez-vous continuer?", vbOKCancel)
If a = vbOK Then
GoTo Supprligne
Else: GoTo fin
End If
Else
Supprligne:
Range("CodeD").FormulaR1C1 = "=" & j - 1 & "-COUNTIF(R[1]C[1]:R[" & j - 1 & "]C[1],"""")"
ThisWorkbook.Names("CriD" & j).Delete
Rows(i & ":" & i).Delete Shift:=xlUp
With Range("A" & i - 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Range("LigneD") = i - 1
Range("LigneE") = Range("LigneE") - 1
Range("LigneF") = Range("LigneF") - 1
Range("LigneG") = Range("LigneG") - 1
Range("LigneH") = Range("LigneH") - 1
Range("LigneI") = Range("LigneI") - 1
Range("LigneJ") = Range("LigneJ") - 1

End If

fin:
Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub AjoutLigneE()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneE")
k = Range("LigneE").Row
j = i - k

Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown
Range("E" & i + 1).FormulaR1C1 = "=IF(R[-1]C[-3]="""",0,50)"
Range("F" & i & ":G" & i).AutoFill Destination:=Range("F" & i & ":G" & i + 1), Type:=xlFillDefault
Sheets("paramètres").Unprotect
Range("A" & i + 1).Borders(xlEdgeTop).LineStyle = xlNone
With Range("A" & i + 1).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("D" & i + 1).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ThisWorkbook.Names.Add Name:="CriE" & j + 1, RefersToR1C1:="=Paramètres!R" & k & "C2:R" & i + 1 & "C4"
Range("CodeE").FormulaR1C1 = "=" & j + 1 & "-COUNTIF(R[1]C[1]:R[" & j + 1 & "]C[1],"""")"

Range("LigneE") = i + 1
Range("LigneF") = Range("LigneF") + 1
Range("LigneG") = Range("LigneG") + 1
Range("LigneH") = Range("LigneH") + 1
Range("LigneI") = Range("LigneI") + 1
Range("LigneJ") = Range("LigneJ") + 1

Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub SupprimeLigneE()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneE")
k = Range("LigneE").Row
j = i - k

If i = k + 1 Then
MsgBox ("Vous ne pouvez pas supprimer cette ligne.")
GoTo fin
ElseIf Range("B" & i) <> "" Then
a = MsgBox("Attention! La ligne que vous souhaitez supprimer n'est pas vide. Voulez-vous continuer?", vbOKCancel)
If a = vbOK Then
GoTo Supprligne
Else: GoTo fin
End If
Else
Supprligne:
Range("CodeE").FormulaR1C1 = "=" & j - 1 & "-COUNTIF(R[1]C[1]:R[" & j - 1 & "]C[1],"""")"
ThisWorkbook.Names("CriE" & j).Delete
Rows(i & ":" & i).Delete Shift:=xlUp
With Range("A" & i - 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Range("LigneE") = i - 1
Range("LigneF") = Range("LigneF") - 1
Range("LigneG") = Range("LigneG") - 1
Range("LigneH") = Range("LigneH") - 1
Range("LigneI") = Range("LigneI") - 1
Range("LigneJ") = Range("LigneJ") - 1

End If

fin:
Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub AjoutLigneF()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneF")
k = Range("LigneF").Row
j = i - k

Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown
Range("E" & i + 1).FormulaR1C1 = "=IF(R[-1]C[-3]="""",0,50)"
Range("F" & i & ":G" & i).AutoFill Destination:=Range("F" & i & ":G" & i + 1), Type:=xlFillDefault
Sheets("paramètres").Unprotect
Range("A" & i + 1).Borders(xlEdgeTop).LineStyle = xlNone
With Range("A" & i + 1).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("D" & i + 1).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ThisWorkbook.Names.Add Name:="CriF" & j + 1, RefersToR1C1:="=Paramètres!R" & k & "C2:R" & i + 1 & "C4"
Range("CodeF").FormulaR1C1 = "=" & j + 1 & "-COUNTIF(R[1]C[1]:R[" & j + 1 & "]C[1],"""")"

Range("LigneF") = i + 1
Range("LigneG") = Range("LigneG") + 1
Range("LigneH") = Range("LigneH") + 1
Range("LigneI") = Range("LigneI") + 1
Range("LigneJ") = Range("LigneJ") + 1

Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub SupprimeLigneF()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneF")
k = Range("LigneF").Row
j = i - k

If i = k + 1 Then
MsgBox ("Vous ne pouvez pas supprimer cette ligne.")
GoTo fin
ElseIf Range("B" & i) <> "" Then
a = MsgBox("Attention! La ligne que vous souhaitez supprimer n'est pas vide. Voulez-vous continuer?", vbOKCancel)
If a = vbOK Then
GoTo Supprligne
Else: GoTo fin
End If
Else
Supprligne:
Range("CodeF").FormulaR1C1 = "=" & j - 1 & "-COUNTIF(R[1]C[1]:R[" & j - 1 & "]C[1],"""")"
ThisWorkbook.Names("CriF" & j).Delete
Rows(i & ":" & i).Delete Shift:=xlUp
With Range("A" & i - 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Range("LigneF") = i - 1
Range("LigneG") = Range("LigneG") - 1
Range("LigneH") = Range("LigneH") - 1
Range("LigneI") = Range("LigneI") - 1
Range("LigneJ") = Range("LigneJ") - 1

End If

fin:
Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub AjoutLigneG()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneG")
k = Range("LigneG").Row
j = i - k

Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown
Range("E" & i + 1).FormulaR1C1 = "=IF(R[-1]C[-3]="""",0,50)"
Range("F" & i & ":G" & i).AutoFill Destination:=Range("F" & i & ":G" & i + 1), Type:=xlFillDefault
Sheets("paramètres").Unprotect
Range("A" & i + 1).Borders(xlEdgeTop).LineStyle = xlNone
With Range("A" & i + 1).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("D" & i + 1).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ThisWorkbook.Names.Add Name:="CriG" & j + 1, RefersToR1C1:="=Paramètres!R" & k & "C2:R" & i + 1 & "C4"
Range("CodeG").FormulaR1C1 = "=" & j + 1 & "-COUNTIF(R[1]C[1]:R[" & j + 1 & "]C[1],"""")"

Range("LigneG") = i + 1
Range("LigneH") = Range("LigneH") + 1
Range("LigneI") = Range("LigneI") + 1
Range("LigneJ") = Range("LigneJ") + 1

Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub SupprimeLigneG()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneG")
k = Range("LigneG").Row
j = i - k

If i = k + 1 Then
MsgBox ("Vous ne pouvez pas supprimer cette ligne.")
GoTo fin
ElseIf Range("B" & i) <> "" Then
a = MsgBox("Attention! La ligne que vous souhaitez supprimer n'est pas vide. Voulez-vous continuer?", vbOKCancel)
If a = vbOK Then
GoTo Supprligne
Else: GoTo fin
End If
Else
Supprligne:
Range("CodeG").FormulaR1C1 = "=" & j - 1 & "-COUNTIF(R[1]C[1]:R[" & j - 1 & "]C[1],"""")"
ThisWorkbook.Names("CriG" & j).Delete
Rows(i & ":" & i).Delete Shift:=xlUp
With Range("A" & i - 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Range("LigneG") = i - 1
Range("LigneH") = Range("LigneH") - 1
Range("LigneI") = Range("LigneI") - 1
Range("LigneJ") = Range("LigneJ") - 1

End If

fin:
Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub AjoutLigneH()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneH")
k = Range("LigneH").Row
j = i - k

Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown
Range("E" & i + 1).FormulaR1C1 = "=IF(R[-1]C[-3]="""",0,50)"
Range("F" & i & ":G" & i).AutoFill Destination:=Range("F" & i & ":G" & i + 1), Type:=xlFillDefault
Sheets("paramètres").Unprotect
Range("A" & i + 1).Borders(xlEdgeTop).LineStyle = xlNone
With Range("A" & i + 1).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("D" & i + 1).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ThisWorkbook.Names.Add Name:="CriH" & j + 1, RefersToR1C1:="=Paramètres!R" & k & "C2:R" & i + 1 & "C4"
Range("CodeH").FormulaR1C1 = "=" & j + 1 & "-COUNTIF(R[1]C[1]:R[" & j + 1 & "]C[1],"""")"

Range("LigneH") = i + 1
Range("LigneI") = Range("LigneI") + 1
Range("LigneJ") = Range("LigneJ") + 1

Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub SupprimeLigneH()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneH")
k = Range("LigneH").Row
j = i - k

If i = k + 1 Then
MsgBox ("Vous ne pouvez pas supprimer cette ligne.")
GoTo fin
ElseIf Range("B" & i) <> "" Then
a = MsgBox("Attention! La ligne que vous souhaitez supprimer n'est pas vide. Voulez-vous continuer?", vbOKCancel)
If a = vbOK Then
GoTo Supprligne
Else: GoTo fin
End If
Else
Supprligne:
Range("CodeH").FormulaR1C1 = "=" & j - 1 & "-COUNTIF(R[1]C[1]:R[" & j - 1 & "]C[1],"""")"
ThisWorkbook.Names("CriH" & j).Delete
Rows(i & ":" & i).Delete Shift:=xlUp
With Range("A" & i - 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Range("LigneH") = i - 1
Range("LigneI") = Range("LigneI") - 1
Range("LigneJ") = Range("LigneJ") - 1

End If

fin:
Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub AjoutLigneI()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneI")
k = Range("LigneI").Row
j = i - k

Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown
Range("E" & i + 1).FormulaR1C1 = "=IF(R[-1]C[-3]="""",0,50)"
Range("F" & i & ":G" & i).AutoFill Destination:=Range("F" & i & ":G" & i + 1), Type:=xlFillDefault
Sheets("paramètres").Unprotect
Range("A" & i + 1).Borders(xlEdgeTop).LineStyle = xlNone
With Range("A" & i + 1).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("D" & i + 1).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ThisWorkbook.Names.Add Name:="CriI" & j + 1, RefersToR1C1:="=Paramètres!R" & k & "C2:R" & i + 1 & "C4"
Range("CodeI").FormulaR1C1 = "=" & j + 1 & "-COUNTIF(R[1]C[1]:R[" & j + 1 & "]C[1],"""")"

Range("LigneI") = i + 1
Range("LigneJ") = Range("LigneJ") + 1

Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub SupprimeLigneI()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneI")
k = Range("LigneI").Row
j = i - k

If i = k + 1 Then
MsgBox ("Vous ne pouvez pas supprimer cette ligne.")
GoTo fin
ElseIf Range("B" & i) <> "" Then
a = MsgBox("Attention! La ligne que vous souhaitez supprimer n'est pas vide. Voulez-vous continuer?", vbOKCancel)
If a = vbOK Then
GoTo Supprligne
Else: GoTo fin
End If
Else
Supprligne:
Range("CodeI").FormulaR1C1 = "=" & j - 1 & "-COUNTIF(R[1]C[1]:R[" & j - 1 & "]C[1],"""")"
ThisWorkbook.Names("CriI" & j).Delete
Rows(i & ":" & i).Delete Shift:=xlUp
With Range("A" & i - 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Range("LigneI") = i - 1
Range("LigneJ") = Range("LigneJ") - 1

End If

fin:
Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub AjoutLigneJ()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneJ")
k = Range("LigneJ").Row
j = i - k

Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown
Range("E" & i + 1).FormulaR1C1 = "=IF(R[-1]C[-3]="""",0,50)"
Range("F" & i & ":G" & i).AutoFill Destination:=Range("F" & i & ":G" & i + 1), Type:=xlFillDefault
Sheets("paramètres").Unprotect
Range("A" & i + 1).Borders(xlEdgeTop).LineStyle = xlNone
With Range("A" & i + 1).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("D" & i + 1).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("A" & i + 1 & ":D" & i + 1).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ThisWorkbook.Names.Add Name:="CriJ" & j + 1, RefersToR1C1:="=Paramètres!R" & k & "C2:R" & i + 1 & "C4"
Range("CodeJ").FormulaR1C1 = "=" & j + 1 & "-COUNTIF(R[1]C[1]:R[" & j + 1 & "]C[1],"""")"

Range("LigneJ") = i + 1

Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub
Sub SupprimeLigneJ()

Sheets("paramètres").Unprotect

Dim i, k, j As Integer
i = Range("LigneJ")
k = Range("LigneJ").Row
j = i - k

If i = k + 1 Then
MsgBox ("Vous ne pouvez pas supprimer cette ligne.")
GoTo fin
ElseIf Range("B" & i) <> "" Then
a = MsgBox("Attention! La ligne que vous souhaitez supprimer n'est pas vide. Voulez-vous continuer?", vbOKCancel)
If a = vbOK Then
GoTo Supprligne
Else: GoTo fin
End If
Else
Supprligne:
Range("CodeJ").FormulaR1C1 = "=" & j - 1 & "-COUNTIF(R[1]C[1]:R[" & j - 1 & "]C[1],"""")"
ThisWorkbook.Names("CriJ" & j).Delete
Rows(i & ":" & i).Delete Shift:=xlUp
With Range("A" & i - 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Range("LigneJ") = i - 1

End If

fin:
Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells
End Sub

Feuille Paramètres:

Private Sub Worksheet_Activate()

Sheets("paramètres").Unprotect
Sheets("paramètres").Range("A1").ClearContents
Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)


ActiveSheet.Unprotect

colonne = Selection.Column
ligne = Selection.Row

If colonne = 2 Then
If Range("E" & ligne) = "Titre" Then
GoTo fin
ElseIf Range("E" & ligne).Value = 50 Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GN_01"
End With
Else: With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GN_00"
End With
End If
ElseIf colonne = 3 Then
'GC_01
If Range("B" & ligne) = "Anomalie engin moteur" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_01"
End With
'GC_02
ElseIf Range("B" & ligne) = "Anomalie matériel remorqué" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_02"
End With
'GC_03
ElseIf Range("B" & ligne) = "Anomalie signalisation" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_03"
End With
'GC_04
ElseIf Range("B" & ligne) = "Comportement incorrect en urgence" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_04"
End With
'GC_05
ElseIf Range("B" & ligne) = "Départ sans ordre (sf manoeuvre)" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_05"
End With
'GC_06
ElseIf Range("B" & ligne) = "Erreur en manoeuvre" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_06"
End With
'GC_07
ElseIf Range("B" & ligne) = "Erreur sur anomalie de signalisation" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_07"
End With
'GC_08
ElseIf Range("B" & ligne) = "Erreur sur mauvaise direction" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_08"
End With
'GC_09
ElseIf Range("B" & ligne) = "Evénements de type divers" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_09"
End With
'GC_10
ElseIf Range("B" & ligne) = "FUA (sf anomalie)" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_10"
End With
'GC_11
ElseIf Range("B" & ligne) = "Installations de traction électrique" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_11"
End With
'GC_12
ElseIf Range("B" & ligne) = "Mauvaise exécution d'arrêt" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_12"
End With
'GC_13
ElseIf Range("B" & ligne) = "Non respect marche à vue" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_13"
End With
'GC_14
ElseIf Range("B" & ligne) = "Non respect règles de traction élect." Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_14"
End With
'GC_15
ElseIf Range("B" & ligne) = "Non respect règles frein" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_15"
End With
'GC_16
ElseIf Range("B" & ligne) = "Non respect signal d'arrêt" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_16"
End With
'GC_17
ElseIf Range("B" & ligne) = "Non respect vitesse limite (sf FUA)" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_17"
End With
'GC_18
ElseIf Range("B" & ligne) = "Omission d'arrêt" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_18"
End With
'GC_19
ElseIf Range("B" & ligne) = "Procédures générales" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_19"
End With
'GC_20
ElseIf Range("B" & ligne) = "Voie" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_20"
End With
'GC_00
Else: With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GC_00"
End With
End If
ElseIf colonne = 4 Then
'GSC_01
If Range("B" & ligne) "Anomalie engin moteur" And (Range("C" & ligne) "Anomalie frein hors essai" Or Range("C" & ligne) = "Anomalie frein lors de l'essai") Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_01"
End With
'GSC_02
ElseIf Range("B" & ligne) "Anomalie engin moteur" And Range("C" & ligne) "Avarie mécanique (sf frein)" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_02"
End With
'GSC_03
ElseIf Range("B" & ligne) "Anomalie engin moteur" And Range("C" & ligne) "Avarie traction" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_03"
End With
'GSC_04
ElseIf Range("B" & ligne) "Anomalie engin moteur" And Range("C" & ligne) "Avaries diverses" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_04"
End With
'GSC_05
ElseIf Range("B" & ligne) "Anomalie engin moteur" And Range("C" & ligne) "Incident divers cause indéterminée" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_05"
End With
'GSC_06
ElseIf Range("B" & ligne) "Anomalie matériel remorqué" And Range("C" & ligne) "Anomalie chargement" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_06"
End With
'GSC_07
ElseIf Range("B" & ligne) "Anomalie matériel remorqué" And (Range("C" & ligne) "Anomalie frein hors essai" Or Range("C" & ligne) = "Anomalie frein lors de l'essai") Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_07"
End With
'GSC_08
ElseIf Range("B" & ligne) "Anomalie matériel remorqué" And Range("C" & ligne) "Avarie mécanique (sf frein)" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_08"
End With
'GSC_09
ElseIf Range("B" & ligne) "Anomalie matériel remorqué" And Range("C" & ligne) "Avaries diverses" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_09"
End With
'GSC_10
ElseIf Range("B" & ligne) "Anomalie matériel remorqué" And Range("C" & ligne) "Détection de boite chaude" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_10"
End With
'GSC_11
ElseIf Range("B" & ligne) "Anomalie matériel remorqué" And Range("C" & ligne) "Fuite CP (sf frein)" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_11"
End With
'GSC_12
ElseIf Range("B" & ligne) "Anomalie matériel remorqué" And Range("C" & ligne) "Incendie ou fumée" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_12"
End With
'GSC_13
ElseIf Range("B" & ligne) "Anomalie matériel remorqué" And Range("C" & ligne) "Instabilité" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_13"
End With
'GSC_14
ElseIf Range("B" & ligne) "Anomalie signalisation" And (Range("C" & ligne) "Anomalie KVB sur signal" Or Range("C" & ligne) = "Anomalie DAAT sur signal" Or Range("C" & ligne) = "Anomalie KCVB/KCVP sur signal" Or Range("C" & ligne) = "Anomalie TVM") Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_14"
End With
'GSC_15
ElseIf Range("B" & ligne) "Anomalie signalisation" And (Range("C" & ligne) "Anomalies diverses" Or Range("C" & ligne) = "Aspect anormal" Or Range("C" & ligne) = "Cascade de feux" Or Range("C" & ligne) = "Explosion de détonateurs" Or Range("C" & ligne) = "Fermeture inopinée" Or Range("C" & ligne) = "Signal éteint") Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_15"
End With
'GSC_16
ElseIf Range("B" & ligne) "Anomalie signalisation" And Range("C" & ligne) "Répétition sur signal" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_16"
End With
'GSC_17
ElseIf Range("B" & ligne) "Erreur sur mauvaise direction" And (Range("C" & ligne) "Arrêt après aiguille" Or Range("C" & ligne) = "Arrêt avant aiguille") Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_17"
End With
'GSC_18
ElseIf Range("B" & ligne) "Evénements de type divers" And Range("C" & ligne) "Accident de personne" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_18"
End With
'GSC_19
ElseIf Range("B" & ligne) "Evénements de type divers" And (Range("C" & ligne) "Acte de malveillance" Or Range("C" & ligne) = "Cause extérieure diverse" Or Range("C" & ligne) = "Conditions climatiques") Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_19"
End With
'GSC_20
ElseIf Range("B" & ligne) "FUA (sf anomalie)" And Range("C" & ligne) "Autres FU conduite : KCVB/KCVP" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_20"
End With
'GSC_21
ElseIf Range("B" & ligne) "FUA (sf anomalie)" And Range("C" & ligne) "Autres FU indéterminé : KCVB/KCVP" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_21"
End With
'GSC_22
ElseIf Range("B" & ligne) "FUA (sf anomalie)" And Range("C" & ligne) "Covit, TVM" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_22"
End With
'GSC_23
ElseIf Range("B" & ligne) "FUA (sf anomalie)" And Range("C" & ligne) "DAAT" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_23"
End With
'GSC_24
ElseIf Range("B" & ligne) "FUA (sf anomalie)" And Range("C" & ligne) "Divers Automatismes" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_24"
End With
'GSC_25
ElseIf Range("B" & ligne) "FUA (sf anomalie)" And Range("C" & ligne) "KVB:FU conduite" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_25"
End With
'GSC_26
ElseIf Range("B" & ligne) "FUA (sf anomalie)" And Range("C" & ligne) "KVB:FU indéterminé" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_26"
End With
'GSC_27
ElseIf Range("B" & ligne) "FUA (sf anomalie)" And Range("C" & ligne) "Préannonce" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_27"
End With
'GSC_28
ElseIf Range("B" & ligne) "FUA (sf anomalie)" And (Range("C" & ligne) "Avarie traction" Or Range("C" & ligne) = "Répétition acoustique des signaux" Or Range("C" & ligne) = "Répétition optique des signaux" Or Range("C" & ligne) = "Veille automatique") Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_28"
End With
'GSC_29
ElseIf Range("B" & ligne) "Installations de traction électrique" And Range("C" & ligne) "Observation avarie caténaire" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_29"
End With
'GSC_30
ElseIf Range("B" & ligne) "Installations de traction électrique" And Range("C" & ligne) "Manque de tension" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GSC_30"
End With
'GSC_31
ElseIf Range("B" & ligne) "Mauvaise exécutio

18 réponses

Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
Bonjour,
Tu aurais du ouvrir (fais donc dorénavant attention au choix du thème, s'il te plait) la présente discussion dans la section Langages dérivés > VBA et non dans celle choisie ( Forum > Visual Basic 6 )
Un code non indenté et non présenté entre balises code (3ème icône en partant de la droite) est pénible. Il devient carrément torture si, de surcroît, il est long.
Isole ton problème technique (lui seul), puis reformule ta question. C'est le principe même de ce forum où l'on ne traite pas un projet, mais uniquement une difficulté technique parfaitement isolée.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'e
Messages postés
28
Date d'inscription
vendredi 13 avril 2012
Statut
Membre
Dernière intervention
9 mai 2012

Oui je suis désolé, je n'ai jamais rien compris au forum et j'ai un, peu de mal, mais j'ai essayer plusieurs forum avant et personne n'a pu aider pour quelques problèmes qu'il soit. Le gros soucis c'est que si on resout un probleme un autre apparait car je reprend le code VBA de quelqu'un d'autre...

Je ferai attention dorénavent.

Merci
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
Le gros soucis c'est que si on resout un probleme un autre apparait car je reprend le code VBA de quelqu'un d'autre...

C'est en général la difficulté lorsque le code n'est pas commenté et que, de surcroît, il a été conduit sans effort réel de conception.
Pour ne rien te cacher, je l'ai malgré tout parcouru (en diagonale, certes, mais cela suffit parfois pour avoir une idée de ce que l'on a sous la dent...)
Je te conseille en ce qui me concerne de tout reprendre à zéro, "zéro" étant le cahier des charges de l'appli.

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'e
Messages postés
28
Date d'inscription
vendredi 13 avril 2012
Statut
Membre
Dernière intervention
9 mai 2012

C'est impossible je n'est pas assez de basse pour tout reprendre car ce code n'est un tout petit morceaux du programme, de plus meme en essayant, je n'est malheureusement que 2 mois de stage et cela ne suffirai pas à tout reprendre !!
Je vais continuer mes recherches en essayant d'aboutir à quelque chose .

Merci
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
Dans ta "reprise à zéro" : efforce-toi au moins de ne pas écrire à ton tour un code "spaghetti" (les goto ... !), de sorte à ce que ton successeur n'ait pas, à son tour, d'énormes difficultés à suivre.
Consacre 3 fois plus de temps à la conception et à la réflexion que celui destiné à l'écriture des instructions.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'e
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
C'est impossible je n'est pas assez de basse pour tout reprendre car ce code n'est un tout petit morceaux du programme, de plus meme en essayant, je n'est malheureusement que 2 mois de stage et cela ne suffirai pas à tout reprendre
!
Je crains alors fort que tu ajouteras des tuyaux de plus (comme s'ils n'étaient pas déjà suffisamment nombreux) à l'usine à gaz déjà présente.
Bonne chance.

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'e
Messages postés
28
Date d'inscription
vendredi 13 avril 2012
Statut
Membre
Dernière intervention
9 mai 2012

Je vais essayer de poser des questions un peu plus compacte sur le forum avant de tout recommencer, mais il me reste 2mois c'est vraiment juste. En tous cas merci d'avoir pris le temps de me repondre !!
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
mais il me reste 2mois c'est vraiment juste

pas vraiment ! C'est beaucoup plus qu'il ne m'en a fallu pour apprendre suffisamment VBA/Excel pour traiter des choses non complexes (et je n'en vois aucune de complexe en survolant le code montré).
Vas-y. Essaye de "sérier". Fais au besoin un test sur un classeur vierge pour chaque "module" à traiter ou définir.
Il faut de toutes manières que tu en parles avec franchise à ton formateur et/ou à l'entreprise dans laquelle tu es en stage. Expose-leur que tu es devant une usine à gaz et qu'il te parait judicieux de tout reprendre. S'ils ne sont pas idiots, ils t'en seront reconnaissants.

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'e
Messages postés
28
Date d'inscription
vendredi 13 avril 2012
Statut
Membre
Dernière intervention
9 mai 2012

Encore un autre probleme, personne dans mon entreprise ne connais VBA. Donc j'ai beau leurs demander ou dire quelque chose il me laisse faire car je suis la seule qui puisse m'occuper de ce programme ^^!
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
Ah !

Commence par leur "mettre le nez dedans" en pointant du doigt le côté "bidouille d'apprenti" de celui qui a écrit ce code !

Je te donne un exemple (à les forcer à voir) : le plus évident de tous (car il y en a plein !) :

Dans son "code", on trouve au moins 14 fois :
Sheets("paramètres").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("paramètres").EnableSelection = xlUnlockedCells


alors que cette ligne n'aurait du se trouver qu' une seule fois , dans une seule procédure, appelable en tant que de besoin. !
Et j'en passe (les goto partout, etc ...) et des meilleures.
Va donc ensuite t'étonner de la longueur de ce code et de son côté imbuvable et difficile à maintenir !

Qu'ils ouvrent donc un peu les yeux ! Cela leur fera du bien


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'e
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
pareil avec ces blocs de lignes répétées :
Range("LigneC") = i - 1
Range("LigneD") = Range("LigneD") - 1
Range("LigneE") = Range("LigneE") - 1
Range("LigneF") = Range("LigneF") - 1
Range("LigneG") = Range("LigneG") - 1
Range("LigneH") = Range("LigneH") - 1
Range("LigneI") = Range("LigneI") - 1
Range("LigneJ") = Range("LigneJ") - 1

où -1 est quelquefois +1
=>> ne devraient être que dans une seule procédure paramétrée (paramètre -1 ou +1), appelable en tant que de besoin. !

Non, vraiment : l'auteur est soit un apprenti bidouilleur, soit un intervenant se faisant payer à la ligne de code !

Mais ce n'est pas tout (et je ne vais pas faire un inventaire exhaustif de toutes les raisons présentes de lourdeur et de difficulté de maintenance. Il y en a tyrop et quand c'est trop, c'est trop).
Je réitère mon avis : tout est à recommencer depuis le cahier des charges.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'e
Messages postés
28
Date d'inscription
vendredi 13 avril 2012
Statut
Membre
Dernière intervention
9 mai 2012

D'accord merci beaucoup de m'avoir aider, je vais essayer de refaire ça à ma "sauce". Et puis je verra bien ou le programme me ménera .
Messages postés
115
Date d'inscription
dimanche 6 avril 2003
Statut
Membre
Dernière intervention
29 juin 2012

bonjour
j'ai lu jusqu'a la "sub ligneC"...
(à mon age on devient un peut lent)
en fait c'est carement la meme sub qui revient
avec quelque modif avec ligne=ligne+1

il faut utiliser une seule "sub Ligne(ElementATransmettre)"
et a la fin pour ligne=ligne+1 trouver une astuce avec
if..en if ou with case...

@+JP
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
Bonjour, mjpmjp,
pas tou-à-fait. Si tu regardes bien, il y a des différences (le i de départ, la ligne de départ et ce qu'il faut y ajouter ==>> donc 3 paramètres)

et donc : une procédure toto ===>>

Private Sub toto(ligne As String, i As Long, ajout As Byte)
  Range("Ligne" & ligne) = i + 1
  For j = Asc(ligne) + 1 To Asc("J")
    Range("Ligne" & Chr(j)).value = Range("Ligne" & Chr(j)).value + 1
  Next
End Sub


Appelable en tant que de besoin. Ainsi, par exemples ici et là :
depuis AjoutLigneA
toto "A", i, 1

depuis SupprimeLigneB
toto "B", i, -1


Mais cela vaut-il le coup, de "tricoter" des verrues sur ce qui est décousu à ce point ? Je ne le crois vraiment pas !
On voit très nettement le côté "bidouilleur" doublé de "je-m'en-foutiste" de celui qui a fait cela.
Faut pas aller loin, pour en être certain ! Dès le début de chaque procédure, par exemple :
Dim i, k, j As Integer

qui ne type vraiment que j (en integer) en laissant i et k non typés, donc Variant !
Même cela lui échappait !
Il a construit cette véritable usine à gaz un peu comme un maçon qui se mettrait à construire sans plan, "à vue", "à tâtons"... ou encore comme un gamin qui, ayant oublié sa table de multiplication, comblerait cette lacune par l'utilisation d'autant d'additions que nécessaires, etc ...
Tout est à refaire : tout !
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
Et le pire : tout son tricotage, pourquoi, finalement ? ===>>
Apparemment pour se "bidouiller" ce qu'il était ultra-facile de confectionner : des plages nommées qu'il suffisait d'étendre, quitte à y réinsérer (quand ajout d'une ligne) la formule de la ligne au-dessus
et tout son code devrait se résumer à moins de 15 lignes (à vue de nez) en tout et pour tout ! Tu te rends compte ?


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
Messages postés
115
Date d'inscription
dimanche 6 avril 2003
Statut
Membre
Dernière intervention
29 juin 2012

bonjour ucfoutu

je me rappelle tres bien un de mes premiers codes en Gwbasic...
y en avais partout mais j'avais vite réalisé qu'on pouvait
reduire considerablement ce code.

il est vrait aude229 qu'il cerait preferable de repenser
la finalité du programme (quel est le but) et la façon d'atteindre ce but.
ce sera beaucoup plus amusant et interressant que de reprendre ce code en vrac.
@+JP
Messages postés
28
Date d'inscription
vendredi 13 avril 2012
Statut
Membre
Dernière intervention
9 mai 2012

Bonjour à tous et merci pour vos message !

Je sais qu'il serai préférable de tous recommencer, mais dans ce fichier il y a beaucoup de mise en page, des liens vers intranet, des graphiques en relations avec des données qui justement sont dans ces tableaux, je ne me crois pas capable de tous reprendre à zero, en deux mois, sachant que je n'ai pas de grande base juste ce que j'ai pu voir en cours et je ne pense pas que cela suffise je me retrouve dans une impasse sans pouvoir avancer...
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
Ce ne sont pas les données de la feuille, qu'il faut effacer et réorganiser, mais leur seul traitement par le code, Aude.
Les données peuvent, elles, rester où elles sont.


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ