[Résolu] Trigger/Fonctions Worksheet_change et Worksheet_selection_change

shahbaz01 · 10 Décembre 2012

Bonjour les expert(e)s,

J'ai deux fonctions à exécuter, dans une même feuille, qui sont de type worksheet_change et worksheet_selection_change. En parcourant des forums, j'ai remarqué qu'elles peuvent se trouver dans la même feuille. Mes 2 subs contiennent 3 codes à exécuter:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Column <> 14 Then Exit Sub
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

'Code 1: Multi-select data validation in a single cell
If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  If Target.Column = 14 Then
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
      Target.Value = oldVal _
        & "; " & newVal
      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True

End Sub

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Code 2: Display column I&J if "Scolaire" or "Service Spécial" is selected at least once in the data validation list of the column H.
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim LR As Long
LR = ActiveSheet.Range("H" & Rows.Count).End(xlUp).Row
Dim LA As Long
LA = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

    Select Case Target.Column
        Case 8
                If WorksheetFunction.CountIf(Range("H2:H" & LR), "Scolaire") > 0 Or _
                   WorksheetFunction.CountIf(Range("H2:H" & LR), "Service Spécial") > 0 Then
                        Columns("I:J").EntireColumn.Hidden = False
                Else
                        Columns("I:J").EntireColumn.Hidden = True
                End If


'Code 3:
        Case 1
                If WorksheetFunction.CountIf(Range("A2:A" & LA), "(Quasi) Echec") > 0 Or _
                   WorksheetFunction.CountIf(Range("A2:A" & LA), "(Quasi) Réussite") > 0 Then
                        Columns("B").EntireColumn.Hidden = False
                Else
                        Columns("B").EntireColumn.Hidden = True
                End If
    End Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Étonnement, les 3 codes ne fonctionnement pas simultanément.
Si je désactive le code 1, le 2 et 3 fonctionnent.
Si je désactive le code 3, le 1 et 2 fonctionnent.
Si je désactive le code 2, seul le code 3 fonctionne.

Pourriez-vous m'aider à exécuter les 3 codes des 2 subs simultanément? Merci d'avance.

Misange · 10 Décembre 2012

Re : Trigger/Fonctions Worksheet_change et Worksheet_selection_change

Bonjour

Plusieurs petites choses à reprendre dans ton code pour le simplifier.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngDV As Range
Dim oldVal As String
Dim newVal As String

If Target.Column <> 14 Then Exit Sub
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)

If Not Intersect(Target, rngDV) Is Nothing Then
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  
  If oldVal <> "" And newVal <> "" Then Target.Value = oldVal & "; " & newVal

End If
Application.EnableEvents = True
End Sub

pas besoin de select case pour le second (regarde ici pour l'utilisation de cette instruction qui ne sert pas à ce que tu penses Ce lien n'existe plus).

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim LR As Long
Dim LA As Long

LR = ActiveSheet.Range("H" & Rows.Count).End(xlUp).Row
LA = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

If WorksheetFunction.CountIf(Range("H2:H" & LR), "Scolaire") > 0 Or _
   WorksheetFunction.CountIf(Range("H2:H" & LR), "Service Spécial") > 0 Then
        Columns("I:J").EntireColumn.Hidden = False
Else
        Columns("I:J").EntireColumn.Hidden = True
End If

If WorksheetFunction.CountIf(Range("A2:A" & LA), "(Quasi) Echec") > 0 Or _
   WorksheetFunction.CountIf(Range("A2:A" & LA), "(Quasi) Réussite") > 0 Then
        Columns("B").EntireColumn.Hidden = False
Else
        Columns("B").EntireColumn.Hidden = True
End If

End Sub

Quand dans un test if then else il ne se passe rien quand la condition n'est pas remplie, il est inutile de le dire 🙂
if ma condition then ce qu'il faut faire
end if
pas besoin de rajouter de else.
Quand toute l'instruction if then (sans else) tient sur une seule ligne (ou avec des _), tu peux te dispenser des end if dans ce cas.

Dans le premier code, il te suffit de tester que c'est la colonne 14 qui est modifiée, pas besoin de traiter le cas où c'est une autre colonne.
Dans ton premier code, le application enableevents = false est indispensable comme tu l'avais mis car sinon ta macro bouclerait sans fin. En revanche ce n'est pas nécessaire dans la seconde. PAs nécessaire non plus de rajouter application.screenupdating = false. Ce ne sert que quand on fait des calculs itératifs sur toute une plage assez longue et que l'affichage ralentirait la macro. Ici ta macro2 ne fait qu'afficher en une fois ou démasquer en une fois des colonnes.

Gelinotte · 10 Décembre 2012

Re : Trigger/Fonctions Worksheet_change et Worksheet_selection_change

Bonjour Misange, shahbaz01,

Sur ma machine "Application.Undo" ne fonctionne pas et bloque le déroulement du code "Erreur d'écution '1004'.

Puis le traitement sur la colonne H ne fonctionne plus. Il faut fermer Excel et le rouvrir. Et là, à nouveau l'erreur.

G

Misange · 10 Décembre 2012

Re : Trigger/Fonctions Worksheet_change et Worksheet_selection_change

Bonjour Gelinotte
C'est étrange.. Le fait de devoir refermer et rouvrir excel c'est que ta macro a planté et qu'excel en est resté à unableevents = false. Du coup il faut le remettre à true de force (tu te fais une macro reset d'une ligne que tu lances manuellement, avec juste application.enableevents = true dedans.
Mais je ne comprends pas que le undo ne fonctionne pas chez toi.
On verra ce que dit le demandeur et si ça marche chez lui.
Il faudrait du reste prévoir dans sa macro ce que doit faire l'utilisateur si il s'est trompé de jour àla saisie dans la liste car là il est cuit il ne peut pas revenir en arrière...

Si... · 10 Décembre 2012

Re : Trigger/Fonctions Worksheet_change et Worksheet_selection_change

salut

"Application.Undo" me donne, aussi, un message d'erreur avec ses conséquences (évènementielles inactives)

Si... j'ai compris, avec un "Select Case" et dans le Module de la feuille*

Code:

Dim newVal As String 'garder ici
Private Sub Worksheet_SelectionChange(ByVal R As Range)
  If R.Column = 14 Then newVal = R.Value 'sauvegarde du contenu
End Sub
Private Sub Worksheet_Change(ByVal R As Range)
  Dim p1 As Range, P2 As Range
  Select Case R.Column
    Case 1
      Set p1 = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
      Columns("B").Hidden = (Application.CountIf(p1, "(Quasi) Echec") + _
                          Application.CountIf(p1, "(Quasi) Réussite") = 0)
    Case 8
      Set P2 = Range("H2:H" & Cells(Rows.Count, 8).End(xlUp).Row)
    Columns("I:J").Hidden = (Application.CountIf(P2, "Scolaire") + _
                          Application.CountIf(P2, "Service Spécial") = 0)
   Case 14
     If R = "" Then Exit Sub
     Application.EnableEvents = False
     If newVal <> "" Then R = newVal & "; " & R
     R.Offset(, 1).Select
     Application.EnableEvents = True
  End Select
End Sub

*

shahbaz01 à dit:
Bonjour les expert(e)s,
J'ai deux fonctions à exécuter, dans une même feuille, qui sont de type worksheet_change et worksheet_selection_change. En parcourant des forums, j'ai remarqué qu'elles peuvent se trouver dans la même feuille.

sans indication contraire, l'évènementielle agit dans la feuille du module de feuille où elle est écrite, donc il faut être attentif à l'endroit où la placer !

Gelinotte · 10 Décembre 2012

Re : Trigger/Fonctions Worksheet_change et Worksheet_selection_change

Bonjour tous,

Le code de Si... fonctionne correctement chez-moi. 🙄

G

Misange · 10 Décembre 2012

Re : Trigger/Fonctions Worksheet_change et Worksheet_selection_change

Oui en fait vous avez raison tous les deux,.
J'ai mis au point le code 1 en désactivant le 2 et je n'ai pas retesté le 1 après avoir mis au point le 2 🙂
Et c'est logique que ça plante vu qu'on fait un changement de sélection avant de faire un changement de valeur.
Voilà donc une version modifiée :
La valeur de la cellule de la colonne 14 est mémorisée au moment du changement de sélection. De cette façon plus besoin d'application undo

Code:

Dim oldVal As String
Dim newVal As String
Dim rngDV As Range
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True

If Target.Column <> 14 Then Exit Sub
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)

If Not Intersect(Target, rngDV) Is Nothing Then
  Application.EnableEvents = False
  newVal = Target.Value
  
  If oldVal <> "" And newVal <> "" Then Target.Value = oldVal & "; " & newVal

End If
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim LR As Long
Dim LA As Long

If Target.Column = 14 Then oldVal = Target.Value

LR = ActiveSheet.Range("H" & Rows.Count).End(xlUp).Row
LA = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

If WorksheetFunction.CountIf(Range("H2:H" & LR), "Scolaire") > 0 Or _
   WorksheetFunction.CountIf(Range("H2:H" & LR), "Service Spécial") > 0 Then
        Columns("I:J").EntireColumn.Hidden = False
Else
        Columns("I:J").EntireColumn.Hidden = True
End If

If WorksheetFunction.CountIf(Range("A2:A" & LA), "(Quasi) Echec") > 0 Or _
   WorksheetFunction.CountIf(Range("A2:A" & LA), "(Quasi) Réussite") > 0 Then
        Columns("B").EntireColumn.Hidden = False
Else
        Columns("B").EntireColumn.Hidden = True
End If


End Sub

shahbaz01 · 10 Décembre 2012

Re : Trigger/Fonctions Worksheet_change et Worksheet_selection_change

Bonjour Misange et Gelinotte, un tout grand merci pour vos promptes réactions.
La colonne N me joue des tours lorsque je sélectionne des jours au sein d'une cellule. Par exemple, dans la cellule N7, en ajoutant un jour, le champ supprime un autre jour indiqué précédemment dans la cellule. Est-il possible de ne pas remplacer mais ajouter le nouveau jour, séparé par une virgule, svp? Merci.

Gelinotte · 10 Décembre 2012

Re : Trigger/Fonctions Worksheet_change et Worksheet_selection_change

Bonsoir,

Exemine cette version-ci ...

G

shahbaz01 · 10 Décembre 2012

Re : Trigger/Fonctions Worksheet_change et Worksheet_selection_change

Un tout grand merci. Cela fait 3 semaines que je cherche une solution, je vous dois une fière chandelle.
Comment puis je marquer la demande comme résolue?

Gelinotte · 10 Décembre 2012

Re : Trigger/Fonctions Worksheet_change et Worksheet_selection_change

Bonsoir,

Content que ça fonctionne bien.

Pour marquer comme résolue, retourne sur le premier post de ce fil, Modifier le message, dans l'entête, ajoute Résolue

G

Effectuez une recherche sur Excel Downloads...

[Résolu] Trigger/Fonctions Worksheet_change et Worksheet_selection_change

shahbaz01

XLDnaute Nouveau

Pièces jointes

Misange

XLDnaute Barbatruc

Pièces jointes

Gelinotte

XLDnaute Accro

Misange

XLDnaute Barbatruc

Si...

XLDnaute Barbatruc

Gelinotte

XLDnaute Accro

Misange

XLDnaute Barbatruc

Pièces jointes

shahbaz01

XLDnaute Nouveau

Gelinotte

XLDnaute Accro

Pièces jointes

shahbaz01

XLDnaute Nouveau

Gelinotte

XLDnaute Accro

Discussions similaires

Nous accordons de l'importance à votre vie privée