Discussion :

[Airone1CF03]

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.

[PMO2017]

Bonjour,

Essayez la démarche suivante

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim R As Range
Set R = Application.Intersect(Range("a1:a45"), Target)
If Not R Is Nothing Then
  Set maSelection = Target
  Call RunTimer(100)
Else
  Call OffTimer
  Set maSelection = Nothing
End If
End Sub

2) copiez le code suivant dans un module standard

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Public maSelection As Range
Public 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 ChangeLineColor(Optional dummy As Byte)
Dim SH As Shape
Dim couleur&
If Not maSelection Is Nothing Then
  couleur& = maSelection.Interior.Color
  For Each SH In ActiveSheet.Shapes
    If SH.Type = msoLine Then     'msoLine = Trait
      If maSelection.Row = SH.TopLeftCell.Row Then
        SH.Line.ForeColor.RGB = couleur&
        Exit For
      End If
    End If
  Next SH
End If
End Sub
 
Sub RunTimer(Delai&)
If OnTimer& > 0 Then OffTimer
OnTimer& = SetTimer(0, 0, ByVal Delai&, AddressOf ChangeLineColor)
End Sub
 
Sub OffTimer(Optional dummy As Byte)
If OnTimer& > 0 Then
  OnTimer& = KillTimer(0&, OnTimer&)
  OnTimer& = 0
End If
End Sub

Pour faciliter je joins un exemple.

Cordialement.

PMO
Patrick Morange

[Airone1CF03]

Merci pour cette réponse.


Pour être franc, je ne comprends pas du tout ce que ce code fait. Serait-il possible d'expliquer ce que ce code fait ?



Ensuite, à moins que cela vienne de mon poste et de ma configuration d'Excel, Excel plante au moindre changement de format d'une cellule entre A1 et A45, et parfois même Excel plante dans la fenêtre "Format des cellules". Est-ce normal ?


Bonne soirée.

[PMO2017]

Bonjour,

Effectivement Excel plante. Je pense qu'il faut externaliser le traitement de la fonction de rappel.

Je m'y suis employé et voici une nouvelle version qui remplace l'ancienne caduque.

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
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)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
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

Serait-il possible d'expliquer ce que ce code fait ?

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.

Est-ce mieux ?

Cordialement.

PMO
Patrick Morange

[Airone1CF03]

Bonsoir,


Merci PMO2017, c'est impeccable !


Par contre, sans vouloir insister, je ne comprends pas une grande partie du code.


Hormis l'évènement "Worksheet_SelectionChange" et la Sub "ChangeLineColor", mes connaissances actuelles de VBA ne me permettent pas de décrire et analyser le code.


Serait-il possible de m'expliquer en détail, de manière à ce que je n'utilise pas ce code "bêtement" ? Sinon, tant pis.



Désolé d'en demander tant, mais j'aime bien connaître le fonctionnement du code VBA.



Bonne soirée et encore merci.