fusionner 2 macros Worksheet_change

[matt31]

Bonjour,

sur le fichier ci-joint, j'ai 2 macros Worksheet_change que je voudrais fusionner mais je n'y arrive pas. Séparemment elles fonctionnent parfaitement mais pas ensembles.

La 1°, pour colorier des lignes en gris en fonction d'une valeur en R, est :

Dim plg, cel As Range
' sur la colonne R
  Set plg = Intersect(Columns("R"), Cible, UsedRange)
  If Not plg Is Nothing Then Exit Sub
    For Each cel In plg.Cells
' si la cellule a pour valeur 05C ou 05D colorier en gris les cellules de la colonne 1 à la colonne 12
      If cel.Value = "05C" Or cel.Value = "05D" Then cel.Offset(0, -17).Resize(1, 12).Interior.ColorIndex = 15 Else cel.Offset(0, -17).Resize(1, 12).Interior.ColorIndex = xlColorIndexNone
      If cel.Value = "05C" Or cel.Value = "05D" Then cel.Offset(0, -7).ClearContents ' supprime la date de traitement initial
      If cel.Value = "05C" Or cel.Value = "05D" Then cel.Offset(0, -6) = "Ann" 'écrit Ann sur la case de validation
    Next
  End If

La 2°, pour vider la 2° liste déroulante en G1 lorsque je change le choix de la liste déroulante en C1, est :

If Not Intersect(Range("C1:C1"), Target) Is Nothing And Target.Count = 1 Then
    Application.EnableEvents = False
    Target.Offset(0, 1) = Empty
   Application.EnableEvents = True
  End If

Merci par avance pour votre aide

 

[mikachu]

Re : fusionner 2 macros Worksheet_change

Bonjour,

avec un goto à la place du exit sub

Private Sub Worksheet_Change(ByVal Cible As Range)
Dim plg, cel As Range
' sur la colonne R
  Set plg = Intersect(Columns("R"), Cible, UsedRange)
  If Not plg Is Nothing Then goto line1
    For Each cel In plg.Cells
' si la cellule a pour valeur 05C ou 05D colorier en gris les cellules de la colonne 1 à la colonne 12
      If cel.Value = "05C" Or cel.Value = "05D" Then cel.Offset(0, -17).Resize(1, 12).Interior.ColorIndex = 15 Else cel.Offset(0, -17).Resize(1, 12).Interior.ColorIndex = xlColorIndexNone
      If cel.Value = "05C" Or cel.Value = "05D" Then cel.Offset(0, -7).ClearContents ' supprime la date de traitement initial
      If cel.Value = "05C" Or cel.Value = "05D" Then cel.Offset(0, -6) = "Ann" 'écrit Ann sur la case de validation
    Next
  End If


line1:
If Not Intersect(Range("C1:C1"), Target) Is Nothing And Target.Count = 1 Then
    Application.EnableEvents = False
    Target.Offset(0, 1) = Empty
   Application.EnableEvents = True
  End If


End Sub

 

[matt31]

Re : fusionner 2 macros Worksheet_change

ça ne fonctionne pas car les 2 macros sont vraiment indépendantes

 

[mikachu]

Re : fusionner 2 macros Worksheet_change

C'et à dire indépendantes ?

En modifiant encore un peu:
Tu vérifie la première condition, si elle est vraie tu exécute le code et tu termine la macro
si elle est fausse, tu vérifie la deuxième condition pour le deuxi-ème code

Private Sub Worksheet_Change(ByVal Cible As Range)
Dim plg, cel As Range
' sur la colonne R
 Set plg = Intersect(Columns("R"), Cible, UsedRange)
  If Not plg Is Nothing Then goto line1
    For Each cel In plg.Cells
' si la cellule a pour valeur 05C ou 05D colorier en gris les cellules de la colonne 1 à la colonne 12
     If cel.Value = "05C" Or cel.Value = "05D" Then cel.Offset(0, -17).Resize(1, 12).Interior.ColorIndex = 15 Else cel.Offset(0, -17).Resize(1, 12).Interior.ColorIndex = xlColorIndexNone
      If cel.Value = "05C" Or cel.Value = "05D" Then cel.Offset(0, -7).ClearContents ' supprime la date de traitement initial
     If cel.Value = "05C" Or cel.Value = "05D" Then cel.Offset(0, -6) = "Ann" 'écrit Ann sur la case de validation
   Next
 goto line2
 End If

line1:
If Not Intersect(Range("C1:C1"), Cible) Is Nothing And Target.Count = 1 Then
    Application.EnableEvents = False
    Target.Offset(0, 1) = Empty
   Application.EnableEvents = True
  End If

line2:
End Sub

 

[matt31]

Re : fusionner 2 macros Worksheet_change

tout d'abord merci pour ton aide.

La 2° macro doit s'exécuter en 1er. Si je change le choix de la 1° liste déroulante cela efface le choix de la 2° liste.
Une fois que j'ai fait ces 2 choix je ne touche plus à ces listes et je passe sur la suite du fichier où la 2° macro peut intervenir.

Sur ta proposition j'ai une erreur d'un End If