Comment mettre 2 procédures Worksheet ensemble et qu'elle s'exécute à la suite

V

verolyde

XLDnaute Nouveau
Bjr,

J'ai créé dans VBA, sur une feuille 2 worksheet et elles ne peuvent s'exécuter ensemble alors que séparement elles marchent trés bien. Je vous ai joint le fichier.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A22:A25")) Is Nothing Then: Exit Sub 'Supprimer pour toute la page With Target
Select Case Target.Value
Case Is = "A"
.Font.ColorIndex = 3 'caractère en rouge
With Selection.Interior
.ColorIndex = 2 'fond blanc
.Pattern = xlSolid
End With
Case Is = "CEF"
.Font.ColorIndex = 7 'caractère en rose
With Selection.Interior
.ColorIndex = 2 'fond blanc
.Pattern = xlSolid
End With
Case Is = "CET"
.Font.ColorIndex = 2 'caractère en blanc
With Selection.Interior
.ColorIndex = 3 'fond rouge
.Pattern = xlSolid
End With
Case Is = "CMAT"
.Font.ColorIndex = 46 'caractère en orange
With Selection.Interior
.ColorIndex = 2 'fond blanc
.Pattern = xlSolid
End With
Case Is = "CPAT"
.Font.ColorIndex = 46 'caractère en orange
With Selection.Interior
.ColorIndex = 2 'fond blanc
.Pattern = xlSolid
End With
Case Is = "CP"
.Font.ColorIndex = 5 'caractère en bleu
With Selection.Interior
.ColorIndex = 2 'fond blanc
.Pattern = xlSolid
End With
Case Is = "CP½A"
.Font.ColorIndex = 5 'caractère en bleu
With Selection.Interior
.ColorIndex = 2 'fond blanc
.Pattern = xlSolid
End With
Case Is = "CP½M"
.Font.ColorIndex = 5 'caractère en bleu
With Selection.Interior
.ColorIndex = 2 'fond blanc
.Pattern = xlSolid
End With
Case Is = "CPE"
.Font.ColorIndex = 9 'caractère en marron
With Selection.Interior
.ColorIndex = 2 'fond blanc
.Pattern = xlSolid
End With
Case Is = "CSS"
.Font.ColorIndex = 8 'caractère en turquoise
With Selection.Interior
.ColorIndex = 2 'fond blanc
.Pattern = xlSolid
End With
Case Is = "EMAL"
.Font.ColorIndex = 1 'caractère en noir
With Selection.Interior
.ColorIndex = 7 'fond rose
.Pattern = xlSolid
End With
Case Is = "EMAL½A"
.Font.ColorIndex = 1 'caractère en noir
With Selection.Interior
.ColorIndex = 7 'fond rose
.Pattern = xlSolid
End With
Case Is = "EMAL½M"
.Font.ColorIndex = 1 'caractère en noir
With Selection.Interior
.ColorIndex = 7 'fond rose
.Pattern = xlSolid
End With
Case Is = "MAL"
.Font.ColorIndex = 1 'caractère en noir
With Selection.Interior
.ColorIndex = 2 'fond blanc
.Pattern = xlSolid
End With
Case Is = "MAL½A"
.Font.ColorIndex = 1 'caractère en noir
With Selection.Interior
.ColorIndex = 2 'fond blanc
.Pattern = xlSolid
End With
Case Is = "MAL½M"
.Font.ColorIndex = 1 'caractère en noir
With Selection.Interior
.ColorIndex = 2 'fond blanc
.Pattern = xlSolid
End With
Case Is = "RTT"
.Font.ColorIndex = 10 'caractère en vert
With Selection.Interior
.ColorIndex = 2 'fond blanc
.Pattern = xlSolid
End With
Case Is = "RTT½A"
.Font.ColorIndex = 10 'caractère en vert
With Selection.Interior
.ColorIndex = 2 'fond blanc
.Pattern = xlSolid
End With
Case Is = "RTT½M"
.Font.ColorIndex = 10 'caractère en vert
With Selection.Interior
.ColorIndex = 2 'fond blanc
.Pattern = xlSolid
End With
Case Is = "RTTE"
.Font.ColorIndex = 2 'caractère en blanc
With Selection.Interior
.ColorIndex = 10 'fond vert
.Pattern = xlSolid
End With
Case Is = "RTTE TRAV"
.Font.ColorIndex = 3 'caractère en rouge
With Selection.Interior
.ColorIndex = 10 'fond vert
.Pattern = xlSolid
End With
Case Else
.Font.ColorIndex = xlNone
.Interior.ColorIndex = xlNone
End Select
End With
End Sub

Je me demande si le texte en rouge ne provoque pas un bug sur la 2eme.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$C$22" Then If Not (IsEmpty(Target.Value)) Then Range("F22").Value = Now Else Range("F22").ClearContents
If Target.Address = "$C$23" Then If Not (IsEmpty(Target.Value)) Then Range("F23").Value = Now Else Range("F23").ClearContents
If Target.Address = "$C$24" Then If Not (IsEmpty(Target.Value)) Then Range("F24").Value = Now Else Range("F24").ClearContents
If Target.Address = "$C$25" Then If Not (IsEmpty(Target.Value)) Then Range("F25").Value = Now Else Range("F25").ClearContents
End Sub

Cette 2eme procedure devrait mettre la date du jour en colonne F puis la convertir pour qu'elle ne change à une prochaine ouverture. Et elle amrche trés bien seule.

Comment transcrire ces procédures en une seule. Merci de votre aide !

Vérolyde:confused:
 

Pièces jointes

  • TEST.xls
    200.5 KB · Affichages: 54
  • TEST.xls
    200.5 KB · Affichages: 63
  • TEST.xls
    200.5 KB · Affichages: 59
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : Comment mettre 2 procédures Worksheet ensemble et qu'elle s'exécute à la suite

Bonsoir le fil, bonsoir le forum,

Il y a deux macros événementielles Change et SelectionChange qui sont complètement indépendantes l'une de l'autre. Tu veux quoi exactement ? C'est pas très clair ta question... Tu veux que les deux codes s'exécutent sur l'événement Change ou qu'ils réagissent sur l'événement SelectionChange ?

Peut-être comme ça :
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("C22:C25")) Is Nothing Then
    If Not (IsEmpty(Target.Value)) Then
        Target.Offset(0, 3).Value = Now
    Else
        Target.Offset(0, 3).ClearContents
    End If
End If
If Intersect(Target, Range("A22:A25")) Is Nothing Then Exit Sub 'Supprimer pour toute la page
    With Target
    Select Case Target.Value
    Case Is = "A"
    .Font.ColorIndex = 3 'caractère en rouge
        With Selection.Interior
        .ColorIndex = 2 'fond blanc
        .Pattern = xlSolid
        End With
    Case Is = "CEF"
    .Font.ColorIndex = 7 'caractère en rose
        With Selection.Interior
        .ColorIndex = 2 'fond blanc
        .Pattern = xlSolid
        End With
    Case Is = "CET"
    .Font.ColorIndex = 2 'caractère en blanc
        With Selection.Interior
        .ColorIndex = 3 'fond rouge
        .Pattern = xlSolid
        End With
    Case Is = "CMAT"
    .Font.ColorIndex = 46 'caractère en orange
        With Selection.Interior
        .ColorIndex = 2 'fond blanc
        .Pattern = xlSolid
        End With
    Case Is = "CPAT"
    .Font.ColorIndex = 46 'caractère en orange
        With Selection.Interior
        .ColorIndex = 2 'fond blanc
        .Pattern = xlSolid
        End With
    Case Is = "CP"
    .Font.ColorIndex = 5 'caractère en bleu
        With Selection.Interior
        .ColorIndex = 2 'fond blanc
        .Pattern = xlSolid
        End With
    Case Is = "CP½A"
    .Font.ColorIndex = 5 'caractère en bleu
        With Selection.Interior
        .ColorIndex = 2 'fond blanc
        .Pattern = xlSolid
        End With
    Case Is = "CP½M"
    .Font.ColorIndex = 5 'caractère en bleu
        With Selection.Interior
        .ColorIndex = 2 'fond blanc
        .Pattern = xlSolid
        End With
    Case Is = "CPE"
    .Font.ColorIndex = 9 'caractère en marron
        With Selection.Interior
        .ColorIndex = 2 'fond blanc
        .Pattern = xlSolid
        End With
    Case Is = "CSS"
    .Font.ColorIndex = 8 'caractère en turquoise
        With Selection.Interior
        .ColorIndex = 2 'fond blanc
        .Pattern = xlSolid
        End With
    Case Is = "EMAL"
    .Font.ColorIndex = 1 'caractère en noir
        With Selection.Interior
        .ColorIndex = 7 'fond rose
        .Pattern = xlSolid
        End With
    Case Is = "EMAL½A"
    .Font.ColorIndex = 1 'caractère en noir
        With Selection.Interior
        .ColorIndex = 7 'fond rose
        .Pattern = xlSolid
        End With
    Case Is = "EMAL½M"
    .Font.ColorIndex = 1 'caractère en noir
        With Selection.Interior
        .ColorIndex = 7 'fond rose
        .Pattern = xlSolid
        End With
    Case Is = "MAL"
    .Font.ColorIndex = 1 'caractère en noir
        With Selection.Interior
        .ColorIndex = 2 'fond blanc
        .Pattern = xlSolid
        End With
    Case Is = "MAL½A"
    .Font.ColorIndex = 1 'caractère en noir
        With Selection.Interior
        .ColorIndex = 2 'fond blanc
        .Pattern = xlSolid
        End With
    Case Is = "MAL½M"
    .Font.ColorIndex = 1 'caractère en noir
        With Selection.Interior
        .ColorIndex = 2 'fond blanc
        .Pattern = xlSolid
        End With
    Case Is = "RTT"
    .Font.ColorIndex = 10 'caractère en vert
        With Selection.Interior
        .ColorIndex = 2 'fond blanc
        .Pattern = xlSolid
        End With
    Case Is = "RTT½A"
    .Font.ColorIndex = 10 'caractère en vert
        With Selection.Interior
        .ColorIndex = 2 'fond blanc
        .Pattern = xlSolid
        End With
    Case Is = "RTT½M"
    .Font.ColorIndex = 10 'caractère en vert
        With Selection.Interior
        .ColorIndex = 2 'fond blanc
        .Pattern = xlSolid
        End With
    Case Is = "RTTE"
    .Font.ColorIndex = 2 'caractère en blanc
        With Selection.Interior
        .ColorIndex = 10 'fond vert
        .Pattern = xlSolid
        End With
    Case Is = "RTTE TRAV"
    .Font.ColorIndex = 3 'caractère en rouge
        With Selection.Interior
        .ColorIndex = 10 'fond vert
        .Pattern = xlSolid
        End With
    Case Else
    .Font.ColorIndex = xlNone
    .Interior.ColorIndex = xlNone
    End Select
    End With
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : Comment mettre 2 procédures Worksheet ensemble et qu'elle s'exécute à la suite

Bonjour verolyde, CHALET53, Bonjour Robert:),
Pas certain d'avoir compris mais j'en étais là:
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A22:A25")) Is Nothing Then: Exit Sub 'Supprimer pour toute la page With Target
With Target
    .Interior.ColorIndex = 2 'fond blanc
   .Font.ColorIndex = 1 'caractère en noir
   Select Case Target.Value
        Case Is = "A"
            .Font.ColorIndex = 3 'caractère en rouge
       Case Is = "CEF"
            .Font.ColorIndex = 7 'caractère en rose
       Case Is = "CET"
            .Font.ColorIndex = 2 'caractère en blanc
           .Interior.ColorIndex = 3 'fond rouge
       Case Is = "CMAT", "CPAT"
            .Font.ColorIndex = 46 'caractère en orange
       Case Is = "CP", "CP½A", "CP½M"
            .Font.ColorIndex = 5 'caractère en bleu
       Case Is = "CPE"
            .Font.ColorIndex = 9 'caractère en marron
       Case Is = "CSS"
            .Font.ColorIndex = 8 'caractère en turquoise
       Case Is = "EMAL", "EMAL½A", "EMAL½M"
            .Interior.ColorIndex = 7 'fond rose
       Case Is = "RTT", "RTT½A", "RTT½M"
            .Font.ColorIndex = 10 'caractère en vert
       Case Is = "RTTE"
            .Font.ColorIndex = 2 'caractère en blanc
           .Interior.ColorIndex = 10 'fond vert
       Case Is = "RTTE TRAV"
            .Font.ColorIndex = 3 'caractère en rouge
           .Interior.ColorIndex = 10 'fond vert
       Case Else
            .Font.ColorIndex = xlNone
            .Interior.Interior.ColorIndex = xlNone
        End Select
End With
End Sub

Cordialement

EDIT
En faiy juste pour la Worksheet_Change... Je n'avais pas bien lu la question :eek:
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

Usine à gaz
  • Résolu(e)
XL 2019 Ne pas utiliser les MFC
Réponses
5
Affichages
369
Usine à gaz
Usine à gaz
B
  • Résolu(e)
Microsoft 365 Besoin d'aide pour faire fonctionner 2 codes VBA ensemble
Réponses
2
Affichages
175
BenExcel
B
R3n0W
  • Résolu(e)
XL 2016 If Not xRgSel Is Nothing Then --> Ne marche pas
Réponses
10
Affichages
233
R3n0W
R3n0W
petitbuzuc
  • Question
XL 2016 Aide pour maj auto de la date + selection multiple dans une liste déroulante
Réponses
5
Affichages
276
fanch55
fanch55
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
401
un internaute
U
PORCHER
  • Question
Microsoft 365 L'indice n'appartient pas à la sélection
Réponses
8
Affichages
374
TooFatBoy
TooFatBoy
halecs93
  • Résolu(e)
XL 2016 Indice n'appartient pas à la sélection : HELP !!!!
2
Réponses
21
Affichages
670
halecs93
halecs93
U
  • Question
Autres [RÉSOLU] Faire afficher ligne sur tout le classeur par double clic et la faire maquer à l’enregistrement
Réponses
11
Affichages
455
un internaute
U
U
  • Question
Autres [RÉSOLU] Pour faire afficher colonne F par double clic dans tout le classeur
Réponses
3
Affichages
381
vgendron
vgendron
Lu76Fer
  • Question
XL 2016 Démo pour positionner un UserForm ou ContextMenu sur la grille (Toute version)
10 11 12
Réponses
178
Affichages
5 K
TooFatBoy
TooFatBoy

Membres actuellement en ligne

5 membres et 71 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 508
Messages
2 089 140
Membres
104 047
dernier inscrit
bravetta