[Catégorie modifiée VB6 -- VBA] Macro qui fonctionne une fois sur quatre

Question

Bonjour,

Je suis débutant en VBA, j'ai cherché et modifié un code pendant une demi journée hier et là je bloque un peu :)

Ce code permet lorsque l'on mets un "X" dans la colone A de griser toute la ligne (jusqu'à la colone K) et lorsqu'on enleve le "X" la ligne redevient normal.

Mon problème lorsque je mets un X dans la colonne A, la ligne ne se grise pas tout le temps (1 fois sur 4 a peu près). Des fois sur une ligne qui ne veut pas se griser, après plusieurs essai, elle se grise!
De plus lorsque j'enleve le X, il reste la colonne K griser alors je suis obligé de la dégriser manuellement.

Si quelqu'un aurai juste la gentillesse de jeter un coup d'oeil à mon code se serai super sympa je pense qu'il y a des ligne qui servent a rien ou mal positionné lol je patoge un peu :


Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Region As Range, Position As Long
    
    Application.ScreenUpdating = False
    
    Position = Range("A1:Y999").End(xlDown).Row
    Set Region = Application.Intersect(Range("A1:A" & Position), Target)
    
    If Region Is Nothing Then
        'MsgBox "La cible n'est pas dans la plage visé."
    Else
    
           If (Target.Value = "X") Then
            ActiveCell.Range("A1:J1").Select
            Selection.Interior.ColorIndex = 15
            'MsgBox "La cible est dans la plage visé."
            Target.Offset(1, 0).Select
             
           End If
  
        If Not (Target.Value = "X") Then
            ActiveCell.Range("A1:J1").Select
            Selection.Interior.ColorIndex = xlNone
            'MsgBox "La cible est dans la plage visé."
            Target.Offset(1, 0).Select
             
           End If
    End If
    
    Application.ScreenUpdating = True
    
End Sub
'

Merci a tous pour vos réponses

Johan

cs_loulou69 · Answer

Bonjour

Je n'observe pas tout à fait la même chose

C'est la ligne en dessous de la ligne où est saisi le X qui se grise Offset(1, 0).

Le problème pour moi vient du résultat de 
Position = Range("A1:Y999").End(xlDown).Row 

Qui rend le numéo de la première ligne vide
même s'il existe des lignes non vides après

je verrai mieux

Position = Target.Row

Tout dépend de ce que l'on veut faire

cs_Jack · Answer

Salut

Tu t'y prends mal.
Worksheet_Change va se déclencher à chaque changement sur la feuille.
Ce qui t'intéresse, c'est de chopper le moment où une des cellules de la colonne A est modifiée.
Donc, première chose : Déterminer si Target couvre une cellule de la colonne A
Set Region = Application.Intersect(Range("A:A"), Target)
suffit amplement.
Ensuite, Target peut représenter un lot de cellules, donc Target.Value ne renverra pas forcement quelque chose.
De plus, en utilisant Target, tu supposes à priori que c'est ta colonne A.
Or, le seul objet qui puisse appartenir à ta colonne A, c'est Region, pas Target.
--> Lister les cellules de la colonne A appartenant à Region :
    Dim maCellule As Range
    For Each maCellule In Region
        If maCellule.Column = 1 Then
            ' Traitement ici
        End If
    NextPour le traitement :
    If maCellule.Value = "X" Then
        ' Grisage de la ligne
    Else
        ' pas de grisage
    End IfPour le grisage, tu veux griser la ligne de la colonne A à J : Alors fais-le :
    With Range(maCellule, maCellule.Offset(0, 9))
        .Interior.ColorIndex = 15  ' ou xlNone selon ce que tu veux faire
    End With
Dernière chose :
Surtout pas de ActiveCell ou de Select dans cette procédure : ActiveCell désigne la cellule sur laquelle tu te trouves et pas celle qui vient d'être modifiée !

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

bigfish_le vrai · Answer

Salut,

y a un snippet ici qui fait pratiquement ce que tu cherche à faire.

Les 2 différences sont :

-la sélection se fait par simple click. Donc pas besoin de saisir un caractère comme le X par exemple.

-la ligne entière est sélectionnée mais cela peu facilement être modifié

je vais essayer de revenir avec une version adaptée à ton besoin

A+

uzumakyuubi · Answer

Merci beaucoup pour toutes vos réponses, je vais essayer les indications que vous m'avez fourni, je vous tiens informé.

Johan

uzumakyuubi · Answer

Alors après quelques modifications, tout a l'air de mieux fonctionner, donc l'idée en faite c'est simplement de griser une ligne (de B et K) lorsque je mets un "x" dans la colonne A et que le grisage se retire si on retire le "x" et ce sur toute les lignes :)

Voici le code modifié qui a l'air de beaucoup mieux fonctionner :


Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Region As Range, Position As Long
    
    Application.ScreenUpdating = False
    
    Position = Target.Row

    Set Region = Application.Intersect(Range("A:A"), Target)
    
    If Region Is Nothing Then
        'MsgBox "La cible n'est pas dans la plage visé."
    Else
    
           If (Target.Value = "x") Then
            ActiveCell.Range("A1:J1").Select
            Selection.Interior.ColorIndex = 15
            'MsgBox "La cible est dans la plage visé."
            Target.Offset(1, 0).Select
             
           End If
  
        If Not (Target.Value = "x") Then
            ActiveCell.Range("A1:K1").Select
            Selection.Interior.ColorIndex = xlNone
            'MsgBox "La cible est dans la plage visé."
            Target.Offset(1, 0).Select
             
           End If
    End If
    
    Application.ScreenUpdating = True

bigfish_le vrai · Answer

Salut,

essai ça:

'Cree par Bigish (3ddI7IHd)
'Le 27/10/2010
'ce code est a mettre dans le code d'une feuille
Option Explicit
Const Marque As String = "\/"
Public Maplage As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   'exemple d'utilisation:  les cellules de la colonne "A" se transforment en Checkbox
   ' pour permettre la coloration des lignes marquées,  par simple clic(dans la colonne A)
   Call PseudoCheckBox(Target)
End Sub
Sub PseudoCheckBox(ByVal Target As Range, Optional ByVal Colonne As String "A", Optional NbCol As Long 10)
    'Par defaut la colonne des marques est la colonne A et le nombre de colonne colorées est de 10
    Dim MaCellule As Range, TempPlage As Range
    
    'on verifi que la  variable target pointe sur la colonne specifiée et sur une cellule  unique
    On Local Error Resume Next
    If Target.Column Columns(Colonne).Column And Target.Cells.Count 1 Then
    If Not Err = 0 Then Exit Sub
        'on desactive la mise a jour de  l'affichage
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        'si la variable target  pointe sur une cellule qui contient deja la marque
        If Target = Marque Then
            Target.ClearContents
            Set Maplage = Target.Resize(1, Target.Column + NbCol)
            Maplage.Interior.ColorIndex = xlNone
            
        'si la variable target pointe sur une cellule  vide
        ElseIf Target.Value = "" Then
            With Target
                .Value = Marque 'on lui ajoute une  marque
                'on met en forme la  cellule
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
            
            'on met en forme la marque
            With Target.Characters(Start:=1, Length:=1).Font
                .Name = "Arial"
                .Size = 7
            End With
            With Target.Characters(Start:=2, Length:=1).Font
                .Name = "Arial"
                .FontStyle = "Italic"
                .Size = 12
            End With
            
            Set Maplage = Target.Resize(1, Target.Column + NbCol)
            Maplage.Interior.ColorIndex = 15
        End If
        'on reactive la mise  a jour de l'affichage
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End If
End Sub

Sub SOSEvenement()
Application.EnableEvents = True
End Sub


A+

uzumakyuubi · Answer

EXELLENT, Merci bigfish_le vrai
c'est juste exellent ça fonctionne a merveille,
MERCI à tous pour la rapidité à laquelle vous avez répondu c'est parfait

Bien à vous

Johan

cs_Jack · Answer

Ton code corrigé (9h54) ne tenait pas compte de toutes mes remarques, notamment sur le fait de ne jamais faire de Select dans ce genre d'évènement.
Il faut tout lire et tout comprendre.
Utiliser du code tout cuit sans en comprendre le fonctionnement n'a pas d'intérêt.

uzumakyuubi · Answer

Je sais jack j'ai essayé de le modifier comme tu me l'avais indiqué mais je ne savais pas l'incorporer correctement. je suis plus que débutant puisque je m'y mets seulement maintenant et sincerement c'est pas facile de débuter quand on connait rien! disons que je vais gentiment m'y mettre mais dans l'immédiat j'avais besoin de ce code pour terminer mon document.
Donc encore merci à tous, Jack je passerai du temps je pense ce soir pour faire des manips et incorporer tes modifs :)

Bon courage à tous

Johan

[Catégorie modifiée VB6 --> VBA] Macro qui fonctionne une fois sur quatre

9 réponses

Votre réponse

Discussions similaires