XL 2010 Comment modifier la plage utilisé par le code en renseignant une ou plusieurs cellule d'une feuille

man.jul

XLDnaute Nouveau
Bonjour

Dans mon code il y a une référence à une plage, je souhaiterais pouvoir changer cette plage en renseignant une cellule (ex sur la feuille congé dans la cellule en N23 en y inscrivant C9:M52) ou deux cellules (ex:sur la feuille congé dans la cellule N23 en y inscrivant C9 et dans la cellule N24 en y inscrivant M52).
Ainsi je n'aurai pas à aller changer la plage dans le code de chaque plage au risque d'en oublier car mon tableau évolue en insérant des lignes au cours de l'année.

Voila en rouge ce que je souhaite changer dans mon code


Public Flag As Boolean

Dim nABSSOGJ&, nABSINC2J&, nABSINC1J&, nABSSOGN&, nABSINC2N&, nABSINC1N&, n12h&, nCA&, nCAJ&, nCAN&, nRPM&

Private Sub Worksheet_Change(ByVal Target As Range)
Dim PW As String
Dim nABSSOGJ As Double
Dim nABSINC2J As Double
Dim nABSINC1J As Double
Dim nABSSOGN As Double
Dim nABSINC2N As Double
Dim nABSINC1N As Double
If Intersect([C9:M52], Target) Is Nothing Then Exit Sub
Col = Chr(Target.Column + 64)
[Q2] = Col & [C67] & ":" & Col & [D67] ' Nombre absence jour sur plage des SOG
[R2] = Col & [C68] & ":" & Col & [D68] 'Nombre absence jour sur plage des INC2
[S2] = Col & [C69] & ":" & Col & [D69] 'Nombre absence jour sur plage des INC1
[U2] = Col & [C67] & ":" & Col & [D67] 'Nombre absence nuit sur plage des SOG
[V2] = Col & [C68] & ":" & Col & [D68] 'Nombre absence nuit sur plage des INC2
[W2] = Col & [C69] & ":" & Col & [D69] 'Nombre absence nuit sur plage des INC1

nABSSOGJ = Range("Q1")
nABSINC2J = Range("R1")
nABSINC1J = Range("S1")
nABSSOGN = Range("U1")
nABSINC2N = Range("V1")
nABSINC1N = Range("W1")

If nABSSOGJ > [D73] Or nABSSOGN > [D73] Then
MsgBox "Le nombre maximal de SOG absent est atteint !", vbCritical, "Absence SOG"
Target.Interior.Color = RGB(255, 255, 255)
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If

If nABSINC2J > [D74] Or nABSINC2N > [D74] Then
MsgBox "Le nombre maximal d'INC2 absent est atteint !", vbCritical, "Absence INC2"
Target.Interior.Color = RGB(255, 255, 255)
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If

If nABSINC1J > [D75] Or nABSINC1N > [D75] Then
MsgBox "Le nombre maximal d'INC1 est atteint !", vbCritical, "Absence INC1"
Target.Interior.Color = RGB(255, 255, 255)
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If

If Intersect([C9:M52], Target) Is Nothing Then Exit Sub
nCA = Application.CountIf(Intersect([9:52], Target.EntireColumn), "CA")
nRPM = Application.CountIf(Intersect([9:52], Target.EntireColumn), "RPM")
nCAJ = Application.CountIf(Intersect([9:52], Target.EntireColumn), "CAJ*")
nCAN = Application.CountIf(Intersect([9:52], Target.EntireColumn), "*CAN")

If (nCA + nCAJ + nRPM) > [C70] Or (nCA + nCAN + nRPM) > [C70] Then
MsgBox "Le nombre maximal de 12 CA total est déjà atteint !", vbCritical, "Saisie CA"
Target.Interior.Color = RGB(255, 255, 255)
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If

If Intersect([C9:M52], Target) Is Nothing Then Exit Sub
n12h = Application.CountIf(Intersect([9:52], Target.EntireColumn), "12h")

If n12h > [C71] Then
MsgBox "Le nombre maximal de 12h pour ce jour est déjà atteint !", vbCritical, "Saisie 12h"
Target.Interior.Color = RGB(255, 255, 255)
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True

End If
End Sub

Merci bien
 

Pièces jointes

  • Position2020.s2 23 04 2020.xlsm
    231 KB · Affichages: 9