Compatibilité Macro 2003 vers 2007

C

charlysquare

XLDnaute Nouveau
Hello,

J'ai une macro de mise en forme conditionnelle qui tourne bien sous excel 2003, mais pas sous 2007.
Le but est de surligner les cases abcisse et ordonnée pour positionner visuellement le curseur.
Sous 2007, je suis obligé de rafraichir l'écran (passer sur une autre fenêtre par exemple, puis revenir sous excel, ou bien encore utiliser l'ascenseur pour rafraichir la vue) pour que mon "calculate" m'affiche bien dynamiquement les couleurs au clic de la souris.

Voici le code :
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Calculate
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)

' Conditionnal formatting
    If Not Application.Intersect(Target, Range("C2:C300")) Is Nothing Then
    On Error Resume Next
    If Target = "Lost" Then
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Interior.ColorIndex = 3
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Font.ColorIndex = 2
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Font.Bold = True
    End If
    If Target = "Win" Then
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Interior.ColorIndex = 4
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Font.ColorIndex = 1
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Font.Bold = True
    End If
    If Target = "Warning" Then
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Interior.ColorIndex = 45
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Font.ColorIndex = 2
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Font.Bold = True
    End If
    If Target = "Cancelled" Then
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Interior.ColorIndex = 1
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Font.ColorIndex = 2
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Font.Bold = True
    End If
    If Target = "Pending" Then
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Interior.ColorIndex = 35
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Font.ColorIndex = 1
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Font.Bold = True
    End If
    If Target = "Detected" Then
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Interior.ColorIndex = 15
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Font.ColorIndex = 1
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Font.Bold = True
    End If
    If Target = "" Then
    Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Interior.ColorIndex = xlNone
    End If
    End If

End Sub

Une idée pour rendre ce script compatible 2003 et 2007 ?

Merci d'avance,

Charly
 
Trier par date Trier par votes
Roland_M

Roland_M

XLDnaute Barbatruc
Re : Compatibilité Macro 2003 vers 2007

bonjour

ton code modifié et testé sous 2007 Ok!

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Calculate
End Sub
Private Sub Worksheet_Change(ByVal Target As Range) ' Conditionnal formatting
If Not Application.Intersect(Target, Range("C2:C300")) Is Nothing Then
   On Error Resume Next
   For Each Rang In Range("C2:C300")
     L = Rang.Row: C = Rang.Column
     InteriorColor = xlNone: FontColor = xlColorIndexAutomatic: FontBold = False
     Select Case Rang
       Case "Lost": InteriorColor = 3: FontColor = 2: FontBold = True
       Case "Win": InteriorColor = 4: FontColor = 1: FontBold = True
       Case "Warning": InteriorColor = 45: FontColor = 2: FontBold = True
       Case "Cancelled": InteriorColor = 1: FontColor = 2: FontBold = True
       Case "Pending": InteriorColor = 35: FontColor = 1: FontBold = True
       Case "Detected": InteriorColor = 15: FontColor = 1: FontBold = True
     End Select
     With Range(Cells(L, C), Cells(L, C))
       .Interior.ColorIndex = InteriorColor: .Font.ColorIndex = FontColor: .Font.Bold = FontBold
     End With
   Next
   On Error GoTo 0
End If
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : Compatibilité Macro 2003 vers 2007

re

tu as vu que j'avais fait une modif dans ce même message à 13h20 !?
et j'espère donc que tu as pris le message après modif et donc après 13h20 !?

quoiqu'il en soit, est-ce que ce code fonctionne sous 2003 ?
car apparemment tu as le problème que sous 2007 !?
 
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : Compatibilité Macro 2003 vers 2007

re

n'aurais tu pas dans ton code ceci: Application.EnableEvents = False
car si c'est la cas l'événement Worksheet_SelectionChange et Worksheet_Change
ne se produise plus ! il faut mettre Application.EnableEvents = True
 
Vote positif 0 Vote négatif
C

charlysquare

XLDnaute Nouveau
Re : Compatibilité Macro 2003 vers 2007

Voilà mon code complet. Mes "App.EnableEvents" sont pourtant dans des if, je n'arrive pas à voir où ça pose problème.. (surtout que ça fonctionne en 2003)

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Calculate
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)

' Suivi date création & date modification
    If Target.Column >= 3 And Target.Row > 1 And Target.Column < 40 And Target.Count = 1 Then
      Application.EnableEvents = False
      If Cells(Target.Row, 1) = "" Then
      Cells(Target.Row, 1) = Now
      Application.EnableEvents = True
      End If
      Cells(Target.Row, 2) = Now
      Application.EnableEvents = True
    End If
    
' Conditionnal formatting
If Not Application.Intersect(Target, Range("C2:C300")) Is Nothing Then
   On Error Resume Next
   For Each Rang In Range("C2:C300")
     L = Rang.Row: C = Rang.Column
     InteriorColor = xlNone: FontColor = xlColorIndexAutomatic: FontBold = False
     Select Case Rang
       Case "Lost": InteriorColor = 3: FontColor = 2: FontBold = True
       Case "Win": InteriorColor = 4: FontColor = 1: FontBold = True
       Case "Warning": InteriorColor = 45: FontColor = 2: FontBold = True
       Case "Cancelled": InteriorColor = 1: FontColor = 2: FontBold = True
       Case "Pending": InteriorColor = 35: FontColor = 1: FontBold = True
       Case "Detected": InteriorColor = 15: FontColor = 1: FontBold = True
     End Select
     With Range(Cells(L, C), Cells(L, C))
       .Interior.ColorIndex = InteriorColor: .Font.ColorIndex = FontColor: .Font.Bold = FontBold
     End With
   Next
   On Error GoTo 0
End If

' Choix successifs
   If Target.Row > 1 And Target.Column = 6 Or Target.Column = 12 Or Target.Column = 14 And Target.Count = 1 Then
     Application.EnableEvents = False
     p = InStr(Target.Offset(0, -1), Target.Value)
     If p > 0 Then
       Target.Offset(0, -1) = Left(Target.Offset(0, -1), p - 1) & _
       Mid(Target.Offset(0, -1), p + Len(Target.Value) + 1)
     Else
        If Len(Target.Offset(0, -1)) = 0 Then
        Target.Offset(0, -1) = Target.Value
        Else
        Target.Offset(0, -1) = Target.Offset(0, -1) & " + " & Target.Value
        End If
     End If
     Target.Value = Target.Offset(0, -1)
     Application.EnableEvents = True
   End If
 
 
End Sub
 
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : Compatibilité Macro 2003 vers 2007

re:

chez moi ce modèle fonctionne correctement !
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Calculate
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)

' Suivi date création & date modification
If Target.Column >= 3 And Target.Row > 1 And Target.Column < 40 And Target.Count = 1 Then
   Application.EnableEvents = False
   If Cells(Target.Row, 1) = "" Then Cells(Target.Row, 1) = Now
   Cells(Target.Row, 2) = Now
   Application.EnableEvents = True
End If
    
' Conditionnal formatting
If Not Application.Intersect(Target, Range("C2:C300")) Is Nothing Then
   On Error Resume Next
   For Each Rang In Range("C2:C300")
     L = Rang.Row: C = Rang.Column
     InteriorColor = xlNone: FontColor = xlColorIndexAutomatic: FontBold = False
     Select Case Rang
       Case "Lost": InteriorColor = 3: FontColor = 2: FontBold = True
       Case "Win": InteriorColor = 4: FontColor = 1: FontBold = True
       Case "Warning": InteriorColor = 45: FontColor = 2: FontBold = True
       Case "Cancelled": InteriorColor = 1: FontColor = 2: FontBold = True
       Case "Pending": InteriorColor = 35: FontColor = 1: FontBold = True
       Case "Detected": InteriorColor = 15: FontColor = 1: FontBold = True
     End Select
     With Range(Cells(L, C), Cells(L, C))
       .Interior.ColorIndex = InteriorColor: .Font.ColorIndex = FontColor: .Font.Bold = FontBold
     End With
   Next
   On Error GoTo 0
End If

' Choix successifs
If Target.Row > 1 And Target.Column = 6 Or Target.Column = 12 Or Target.Column = 14 And Target.Count = 1 Then
   Application.EnableEvents = False
   P = InStr(Target.Offset(0, -1), Target.Value)
   If P > 0 Then
      Target.Offset(0, -1) = Left(Target.Offset(0, -1), P - 1) & _
      Mid(Target.Offset(0, -1), P + Len(Target.Value) + 1)
   Else
      If Len(Target.Offset(0, -1)) = 0 Then
         Target.Offset(0, -1) = Target.Value
      Else
         Target.Offset(0, -1) = Target.Offset(0, -1) & " + " & Target.Value
      End If
   End If
   Target.Value = Target.Offset(0, -1)
   Application.EnableEvents = True
End If

End Sub

une chose toute bête que tu sais probablement (mais bon, j'ai déjà vu pire)
Voir dans les Options Excel (dans 2007 c'est le dessin Rond en haut à gauche)
le Button Options Excel est en bas de cette fenêtre une fois ouverte.
Une fois dans cet encadré il y a à gauche des choix et en face une fenêtre avec les options:
Choix: Formules > et dans les options cocher Calcul automatique

ensuite et surtout !
Choix: Centre de gestion de la confidentialité
puis en face il y a Paramètres du centre de gestion de la confidentialité... (cliquer dessus)
puis faire
Choix: Paramètres des macros > puis en face cocher Activer toutes les macros

si c'est pas ça je ne vois pas !?
 
Dernière édition:
Vote positif 0 Vote négatif
C

charlysquare

XLDnaute Nouveau
Re : Compatibilité Macro 2003 vers 2007

Bonsoir,

Oui j'avais effectivement bien placé les options en vérifiant notamment ces 2 paramètres, mais rien à faire.. ce doit être mon excel 2007 qui est mal installé.. Je vais tenter la réinstallation.

En tout cas, merci pour ta persévérance ;=)

Charly
 
Vote positif 0 Vote négatif

Discussions similaires

H
  • Question
Microsoft 365 Evénement arrondi au multiple sup
Réponses
6
Affichages
196
hbb
H
Dadi147
  • Résolu(e)
XL 2016 cellules A, b, C et D sont automatiquement vides
Réponses
3
Affichages
396
job75
job75
H
  • Question
Autres mise a jour automatique feuille excel vba
Réponses
2
Affichages
323
HANN
H
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
403
un internaute
U
U
  • Question
Autres {RÉSOLU] Problème macro
Réponses
2
Affichages
546
un internaute
U
N
  • Résolu(e)
XL 2021 Masquer ligne vba
Réponses
2
Affichages
328
NicolasKH
N
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
1 K
un internaute
U
U
  • Question
Autres [RESOLU] Déclaration de variable
Réponses
5
Affichages
243
un internaute
U
F
  • Résolu(e)
XL 2021 fermeture du classeur après apple d'un userform d'un autre classeur ouvert
Réponses
2
Affichages
133
farid
F
J
  • Question
XL 2019 recuperer plage de cellule sur feuille differente
Réponses
2
Affichages
377
juju91
J

Membres actuellement en ligne

22 membres et 270 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 545
Messages
2 089 465
Membres
104 173
dernier inscrit
RavraX