[XL-2003] Possibilité de capter l'évènement de modification du format d'une cell

Signaler
Messages postés
24
Date d'inscription
vendredi 13 novembre 2009
Statut
Membre
Dernière intervention
27 juin 2012
-
Messages postés
44
Date d'inscription
mardi 6 décembre 2005
Statut
Membre
Dernière intervention
25 avril 2019
-
Bonjour à tous,


Travaillant sur Visual Basic 6.3 d'Excel 2003, je cherche à faire une manipulation mais je n'y arrive pas.


J'ai, dans ma feuille de calcul, ma 1ère colonne avec les 45ères cellules contenant 45 couleurs différentes en motif (ou fond de cellule). Dans la colonne d'à côté (la 2ème) figurent 45 traits (issus d'une forme automatique) dans 45 cellules correspondant donc aux 45 cellules de la colonne d'à côté.


Mon objectif est (qu'à chaque modification du fond de couleur de la cellule en 1ère colonne) que le trait prenne la même couleur que la couleur affectée en tant que fond de la cellule correspondante.



Est-il possible de capter l'évènement de modification du format d'une cellule (ce qui est différent de l'évènement de modification de la valeur d'une cellule) ? Si la réponse est négative, quelle serait la meilleure parade pour tendre vers mon objectif ?


Pour moi, je n'ai pas trouvé d'évènement captant la modification d'une cellule.

Pour réaliser ce que je souhaite, j'ai donc utiliser l'évènement "Worksheet_SelectionChange". Cela permet de faire ce que je veux, avec le bémol que la couleur du trait ne se modifie que si une nouvelle cellule est sélectionnée.

Ma 2ème idée serait de mettre un bouton qui appelle la macro de mise à jour des couleurs des traits. Cela serait un peu comme le recalcul sur ordre effectué à la place du recalcul automatique pour les feuilles de calcul dans Excel.



En tout cas, merci d'avance de prendre ma question en considération, en vous souhaitant une bonne journée.

9 réponses

Messages postés
44
Date d'inscription
mardi 6 décembre 2005
Statut
Membre
Dernière intervention
25 avril 2019

Bonjour,
Ton problème ressemble bigrement au mien exposé dans ce fil sur ce forum.
Les buts sont différents mais le souci est de pouvoir gérer les événements de format de cellule.
Je me mets donc à l'écoute des réponses que tu pourrais avoir.
Apolinaire
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
10
Salut,

le code suivant est à coller dans le code de la feuille "calcul"

Option Explicit

Const ColSource As String = "B" 'colonne source des couleurs
Dim PrecedenteCellule As Range, CouleurPrecedenteCellule As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
        'ici on recupere les info sur la/les cellule(s) precedente(s)
        'les cellules Z1 et Z2 sont des choix arbitraires qui ne servent qu'a conserver ce qui nous interesses
        Set PrecedenteCellule = Me.Range(Range("Z1").Value)
        CouleurPrecedenteCellule = Me.Range("Z2").Value
    On Error GoTo 0
    
    If Not PrecedenteCellule Is Nothing Then 'cas des cellules en Z vide ou ne contenant pas d'adresse
        If Not CouleurPrecedenteCellule = PrecedenteCellule.Cells(1, 1).Interior.ColorIndex Then
            Dim Cellule As Range
            For Each Cellule In PrecedenteCellule
                'ici il faut adapter le code au type d'objet qui doit changer de couleur
                'pour la demo on change la couleur de la cellule limitrophe à la colonne source
                If Cellule.Column = Columns(ColSource).Column Then
                    Cellule.Offset(0, 1).Interior.ColorIndex = Cellule.Interior.ColorIndex
                End If
            Next
        End If
    End If
    If Not Intersect(Target, Columns(ColSource)) Is Nothing Then  'si la selection croise la colonne source
        'on enregistre les info de la selection courante
        Range("Z1").Value = Me.Target.Address
        Range("Z2").Value = Me.Target.Cells(1, 1).Interior.ColorIndex
    End If
End Sub


Apolinaire, il me semble que ton problème est plus complexe à résoudre car contrairement à Airone1CF03 il faut que tu gères beaucoup de paramètres de format. il serait peut être plus simple d'interdire l’accès aux fonctions qui permettent de modifier ce que tu ne veux pas voir modifiés.
Vas voir ici
j'ai posté un code dans ce sens.

A+
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
10
oups !

en version corrigee:

Option Explicit

Const ColSource As String = "B" 'colonne source des couleurs
Dim PrecedenteCellule As Range, CouleurPrecedenteCellule As Variant


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
'ici on recupere les info sur la/les cellule(s) precedente(s)
'les cellules Z1 et Z2 sont des choix arbitraires qui ne servent qu'a conserver ce qui nous interesses
Set PrecedenteCellule = Me.Range(Range("Z1").Value)
CouleurPrecedenteCellule = Me.Range("Z2").Value
On Error GoTo 0

If Not PrecedenteCellule Is Nothing Then 'cas des cellules en Z vide ou ne contenant pas d'adresse
If Not CouleurPrecedenteCellule = PrecedenteCellule.Cells(1, 1).Interior.ColorIndex Then
Dim Cellule As Range
For Each Cellule In PrecedenteCellule
'ici il faut adapter le code au type d'objet qui doit changer de couleur
'pour la demo on change la couleur de la cellule limitrophe à la colonne source
If Cellule.Column = Me.Columns(ColSource).Column Then
Cellule.Offset(0, 1).Interior.ColorIndex = Cellule.Interior.ColorIndex
End If
Next
End If
End If
If Not Intersect(Target, Me.Columns(ColSource)) Is Nothing Then 'si la selection croise la colonne source
'on enregistre les info de la selection courante
Range("Z1").Value = Target.Address
Range("Z2").Value = Target.Cells(1, 1).Interior.ColorIndex
End If
End Sub


A+
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
10
si y a un admin qui passe par la nerci de supprimer mon message precedent

donc je disais:

oups !

en version corrigee:

Option Explicit

Const ColSource As String = "B" 'colonne source des couleurs
Dim PrecedenteCellule As Range, CouleurPrecedenteCellule As Variant


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
        'ici on recupere les info sur la/les cellule(s) precedente(s)
        'les cellules Z1 et Z2 sont des choix arbitraires qui ne servent qu'a conserver ce qui nous interesses
        Set PrecedenteCellule = Me.Range(Range("Z1").Value)
        CouleurPrecedenteCellule = Me.Range("Z2").Value
    On Error GoTo 0
    
    If Not PrecedenteCellule Is Nothing Then 'cas des cellules en Z vide ou ne contenant pas d'adresse
        If Not CouleurPrecedenteCellule = PrecedenteCellule.Cells(1, 1).Interior.ColorIndex Then
            Dim Cellule As Range
            For Each Cellule In PrecedenteCellule
                'ici il faut adapter le code au type d'objet qui doit changer de couleur
                'pour la demo on change la couleur de la cellule limitrophe à la colonne source
                If Cellule.Column = Me.Columns(ColSource).Column Then
                    Cellule.Offset(0, 1).Interior.ColorIndex = Cellule.Interior.ColorIndex
                End If
            Next
        End If
    End If
    If Not Intersect(Target, Me.Columns(ColSource)) Is Nothing Then  'si la selection croise la colonne source
        'on enregistre les info de la selection courante
        Range("Z1").Value = Target.Address
        Range("Z2").Value = Target.Cells(1, 1).Interior.ColorIndex
    End If
End Sub


A+
Messages postés
24
Date d'inscription
vendredi 13 novembre 2009
Statut
Membre
Dernière intervention
27 juin 2012

Bonsoir,


Merci pour cette réponse.


Ton code est bien rédigé. Mais le problème, c'est qu'il ne solutionne pas mon problème. En effet, lorsqu'on modifie le fond de couleur de "B4", la cellule "C4" ne prend le même fond de couleur que si on clique sur une cellule différente de "B4".

Mon objectif est que C4 prenne le même fond de couleur que B4 dès qu'on change la couleur de "B4" (sans avoir besoin de changer de cellule).


Merci quand même.


Bonne soirée.
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
10
Salut,



y a pas d'évènements qui permettent de faire ce que veux ! Donc y a pas de miracle, ici ton objectif est dans excel et comme aurait su le dire Lapalisse Excel c'est de l'excel !!!

Maintenant y aurait peut être un moyen bâtard avec un timer ou une boucle do loop mais la on rentre dans l'usine a gaz... honetement je crois pas que tu sois capable de le faire au vu de ton implication dans une recherche de solution.

Et perso j'ai autre chose a faire...

bon courage.
Messages postés
44
Date d'inscription
mardi 6 décembre 2005
Statut
Membre
Dernière intervention
25 avril 2019

Bonjour Bigfish_le vrai

Je t'ai répondu sur mon fil de discussion pour ne pas polluer celui de Airone1CF03.

Apolinaire
Messages postés
24
Date d'inscription
vendredi 13 novembre 2009
Statut
Membre
Dernière intervention
27 juin 2012

Bonsoir à tous,


En réponse à bigfish_levrai, je ne vais pas dire qu'une solution donnée par un forumeur résout mon problème alors que ce n'est pas le cas, par seul but de ne pas vouloir froisser ce même forumeur.


Ça ne correspond pas à ce que j'attends et c'est tout. Après, il me semble avoir expliqué clairement mon problème dans un français extrêmement correct et sans fautes d'orthographes. De même, je me suis montré très courtois et poli en remerciant de l'aide fournie.


Alors avant de parler de mon pseudo manque d'implication, il serait bien de lire intégralement ce que je souhaite et d'arrêter de s'offusquer comme un enfant de 5 ans. De même, je ne force personne à m'aider : si je ne reçois pas d'aide ou si aucune réponse ne solutionne mon problème, et bien tant pis pour moi, je me débrouille autrement.



Sinon, voici une solution qui correspond à mes attentes, donnée par PMO2017 sur le forum developpez.net (voir ICI) :




1) copiez le code suivant dans la fenêtre de code de la feuille concernée

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim R As Range
Set R = Application.Intersect(Range("a1:a45"), Target)
If R Is Nothing Then
  Call OffTimer
Else
  Call RunTimer(100)
End If
End Sub



2) copiez le code suivant dans un module standard (le traitement a été externalisé en employant OnTime)

Private OnTimer&

Private Declare Function SetTimer& Lib "user32" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long, _
  ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Private Declare Function KillTimer& Lib "user32" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long)

Sub LaunchTimer(Optional dummy As Byte)
Call OffTimer
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), "ChangeLineColor"
End Sub

Sub ChangeLineColor(Optional dummy As Byte)
Dim SH As Shape
Dim R As Range
Dim R2 As Range
Set R = ActiveCell
Set R2 = Application.Intersect(Range("a1:a45"), R)
If Not R2 Is Nothing Then
  For Each SH In ActiveSheet.Shapes
    If SH.Type msoLine Then     'msoLine Trait
      If R.Row = SH.TopLeftCell.Row Then
        SH.Line.ForeColor.RGB = R.Interior.Color
        Exit For
      End If
    End If
  Next SH
  Call RunTimer(100)
End If
End Sub
 
Sub RunTimer(Delai&)
If OnTimer& > 0 Then OffTimer
OnTimer& = SetTimer(0, 0, ByVal Delai&, AddressOf LaunchTimer)
End Sub
 
Sub OffTimer(Optional dummy As Byte)
If OnTimer& > 0 Then
  OnTimer& = KillTimer(0&, OnTimer&)
  OnTimer& = 0
End If
End Sub




L'idée est d'utiliser un Timer grâce aux APIs. Chaque fois qu'une cellule en A1 : A45 est sélectionnée, l'évènement Worksheet_SelectionChange lance le Timer qui appelle une fonction de rappel (CallBack) qui tourne en tâche de fond et qui applique le traitement.






Bonne soirée.
Messages postés
44
Date d'inscription
mardi 6 décembre 2005
Statut
Membre
Dernière intervention
25 avril 2019

Bonjour Airone1CF03,
Merci d'avoir collé ce code ici. Un premier coup d'oeil me porte à croire qu'il va pouvoir servir à résoudre aussi mon problème, sous réserve de quelques adaptations.
Bonne journée.
Apolinaire