Exercice N° 2 (Coloration suivant clic cellule)

kiss6 · Septembre 10, 2018, 3:05

Re,

Toujours pareil vouloir aller trop vite

Cdlt

Mimimathy · Septembre 10, 2018, 3:07

Re,
Oui, mais dés fois, faire des erreurs, donne du bon au résultat que l’on pourrait utiliser autrement (sur un autre montage par exemple)

kiss6 · Septembre 10, 2018, 3:18

Re,

Pourriez-vous me dire comment réinitialiser le classeur a l’origine sans que je le retélécharge a chaque fois

Cdlt

@kiss6

Mimimathy · Septembre 10, 2018, 3:21

Re,
soit le fermer sans l’enregistrer
soit si c’est des modifs en VBA, depuis le ruban de Visual Basic avec les petites flèches (en bleu normalement si il y a possibilité de retour arrière ou avant)

kiss6 · Septembre 10, 2018, 3:23

Re,

Je laisse @mdo100 écrire

Cdlt

@kiss6

mdo100 · Septembre 10, 2018, 3:30

Salut @Mimimathy, @kiss6,

Bien vu la modif de @kiss6, je n’ais pas encore eu le courage de m’y remettre, mais je n’oublie pas.

Toutefois l’union fait la force, alors si il y a d’autres intervenants(tes) qui veulent s’y mettre à la bonne heure

Mais j’aurai bien voulu voir la sac de @sadi58

Cordialement.

kiss6 · Septembre 10, 2018, 3:36

Re ,

@Mimimathy il n’y a pas de retour avec les flèches bleu pour le VBA et si je le ferme sans l’enregistrer il faut

le retélécharger

@mdo100 la modif n’est pas extraordinaire juste changer le -2 en -1 le plus dur reste a venir

Cdlt

@kiss6

mdo100 · Septembre 10, 2018, 3:47

Re @kiss6,

Une fois que tu télécharge le fichier, tu l’enregistre sans aucune modif et tu en fait une copie sur laquelle tu peux travailler en toute tranquillité.
Au mieux, tu dupliques plusieurs feuilles.

Cdlt.

kiss6 · Septembre 10, 2018, 3:48

Re,

Merci @mdo100 c’est ce que je vais faire

Cdlt

@kiss6

mdo100 · Septembre 10, 2018, 5:11

@Mimimathy, et toutes et tous,

Regarde si j’ai légèrement fait avancer le bouchon

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Dl%, Dc%

Dl = ActiveCell.Column - 1
Dc = ActiveCell.Row - 1

 If Not Application.Intersect(Target, [A1:J10]) Is Nothing Then
    [A1:J10].Interior.ColorIndex = xlNone
    
    If ActiveCell.Value <> "" Then
        Range(ActiveCell.Address, ActiveCell.Offset(0, -Dl).Address).Interior.ColorIndex = 6
        Range(ActiveCell.Address, ActiveCell.Offset(-Dc, 0).Address).Interior.ColorIndex = 6
        [B2:J10].Font.Bold = False
        [B2:J10].Font.ColorIndex = xlAutomatic
        ActiveCell.Font.Bold = True
        ActiveCell.Font.ColorIndex = 3
    Else
       [A1:J10].Font.ColorIndex = xlAutomatic
        Range(ActiveCell.Address, ActiveCell.Offset(0, -Dl).Address).Interior.ColorIndex = 4
        Range(ActiveCell.Address, ActiveCell.Offset(-Dc, 0).Address).Interior.ColorIndex = 4
    
    End If
 End If
 
End Sub

Mimimathy · Septembre 10, 2018, 6:19

Salut MDO

Ouais, c’est pas mal, pour le changement de couleur, tu as compris le IF (si) du VBA

Mais j’ai une intrigue avec au début Dl et Dc
Dl c’est pour la ligne ou la colonne ??

Une correction facile à voir aussi :
Dans ton IF, sur les deux couleurs possible, tu remets les couleurs en automatique OK
mais pourquoi ne pas le mettre avant le IF,(ou les) ainsi que la couleur de police et son “Gras”

Ainsi, tout est remis à plat avant les conditions, surtout que la couleur y est déjà en XlNone

Ceci étant remis en bonne position, il ne restera plus qu’à rendre la plage dynamique
Si j’ajoute une ligne ou une colonne, il faut que çà suive

Mais là c’est du gâteau,

mdo100 · Septembre 10, 2018, 6:45

@Mimimathy,

Oui tu as raison, mes variables étaient mal déclarées.

Dc = ActiveCell.Column - 1 'Dernière colonne
Dl = ActiveCell.Row - 1 'Dernière ligne

J’ai corrigé le reste du code.

Je suivrai tes conseils pour continuer demain.

Tu rigole là

Bonne soirée.

kiss6 · Septembre 11, 2018, 7:08

Re ,

Bonjour a tous

Voila ce que j’ais rajouter difficilement car quand on a aucune notion du VBA c’est pas évident

j’ais rajouter cette ligne

Cells.Interior.ColorIndex = 0

c’la nous donne qu’une seule couleur a l’intersection des cellules active

@Mimimathy vous me direz ce soir si c’la vous convient il faut que je parte

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Dl%, Dc%

Dl = ActiveCell.Column - 1 'Derniere colonne
Dc = ActiveCell.Row - 1 'Derniere ligne

If Not Application.Intersect(Target, [B2:J10]) Is Nothing Then
[B2:J10].Interior.ColorIndex = xlNone
Cells.Interior.ColorIndex = 0
If ActiveCell.Value <> « » Then
Range(ActiveCell.Address, ActiveCell.Offset(0, -Dl).Address).Interior.ColorIndex = 6
Range(ActiveCell.Address, ActiveCell.Offset(-Dc, 0).Address).Interior.ColorIndex = 6
[B2:J10].Font.Bold = False
[B2:J10].Font.ColorIndex = xlAutomatic
ActiveCell.Font.Bold = True
ActiveCell.Font.ColorIndex = 3
Else
[B2:J10].Font.ColorIndex = xlAutomatic
Range(ActiveCell.Address, ActiveCell.Offset(0, -Dl).Address).Interior.ColorIndex = 4
Range(ActiveCell.Address, ActiveCell.Offset(-Dc, 0).Address).Interior.ColorIndex = 4
End If
End If

End sub

Cdlt

@kiss6

Mimimathy · Septembre 11, 2018, 11:07

Bonjour à tous

Salut Kiss,

Pas mal

encore un effort pour rendre cela dynamique en ajoutant colonne et ligne

mdo100 · Septembre 12, 2018, 6:33

Salut Mimimathy, toutes et tous,

Je suis arrivé a rendre la plage dynamique, ça fonctionne bien avec la coloration en rouge des données dans le tableau, mais je n’arrive plus a coloriser les plages en jaune et / ou verte j’ai une erreur , voir ci-joint la capture écran.

Capture

Le code VBA.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Dl%, Dc%
Dim Pl As Range

 Dl = Range("B" & Rows.Count).End(xlUp).Row
 Dc = Cells(2, Cells.Columns.Count).End(xlToLeft).Column
 Set Pl = Range(Cells(2, 2), Cells(Dl, Dc))

    If Not Application.Intersect(Target, Pl) Is Nothing Then
    Pl.Interior.ColorIndex = xlNone
    Cells.Interior.ColorIndex = 0
     If ActiveCell.Value <> "" Then
      'Range(ActiveCell.Address, ActiveCell.Offset(0, -Dl).Address).Interior.ColorIndex = 6
      'Range(ActiveCell.Address, ActiveCell.Offset(-Dc, 0).Address).Interior.ColorIndex = 6
      Pl.Font.Bold = False
      Pl.Font.ColorIndex = xlAutomatic
      ActiveCell.Font.Bold = True
      ActiveCell.Font.ColorIndex = 3
    Else
      Pl.Font.ColorIndex = xlAutomatic
      'Range(ActiveCell.Address, ActiveCell.Offset(0, -Dl).Address).Interior.ColorIndex = 4
      'Range(ActiveCell.Address, ActiveCell.Offset(-Dc, 0).Address).Interior.ColorIndex = 4
     End If
    End If
End Sub

Le fichier: Colorisation sur clic cellue.xlsm (17,9 Ko)

@+

Mimimathy · Septembre 12, 2018, 7:11

Salut MDO,

En exemple sur cette ligne, pourquoi cela bloque:

Déjà Dl et Dc sont faux
Dl c’est la dernière ligne remplie, or tu là place en colonne B → soit ligne 24 (Eh oui le texte est pris en compte) en colonne A c’est bon cela s’arrête à 10
Dc - tu prend la ligne 2 et te donne comme résultat 8. Derniere colonne rempli depuis la ligne 2 (en I2)
Pl est bon quand tu auras rectifié Dl et Dc

Tu te trouve sur la cellule F7 cliquée
ActiveCell.Address = $F$7 -->normal
ActiveCell.Offset(0, -Dl).Address → BUG car tu décales de 0 ligne et de -DL (soit de -10) → 7-10 =Bug la ligne -3 n’existe pas

Au lieu d’employer .address, utilise Target
place en exemple dans ton code après le 1er If les deux lignes suivantes:

msgbox target.row
msgbox target.column

quand la macro se déroulera, elle s’arrêtera pour te donner un message avec le N° ligne (Row) et après le OK le N° de la colonne (Column)
avec ces deux target, et Dl et Dc, tu pourra jongler sur la plage à coloriée

kiss6 · Septembre 12, 2018, 7:44

Re,

Bonsoir a tous

Voila ce que j’ais concocter mais c’est pas bon car lorsque je clic sur B2 j’ais bien toute les cellules de la

même couleur sauf bien sur la cellule B2 qui reste en jaune

Mais lorsque je clic sur J10tous est décaler

@mdo100 au secours

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Dl%, Dc%

Dl = ActiveCell.Column - 1 'Derniere colonne
Dc = ActiveCell.Row - 1 'Derniere ligne

If Not Application.Intersect(Target, [B2:J10]) Is Nothing Then
[B2:J10].Interior.ColorIndex = xlNone
Cells.Interior.ColorIndex = 0
Range(ActiveCell.Address, ActiveCell.Offset(8, 8).Address).Interior.ColorIndex = 4
Range(ActiveCell.Address, ActiveCell.Offset(8, 8).Address).Interior.ColorIndex = 4

If ActiveCell.Value <> « » Then
Range(ActiveCell.Address, ActiveCell.Offset(0, -Dl).Address).Interior.ColorIndex = 6
Range(ActiveCell.Address, ActiveCell.Offset(-Dc, 0).Address).Interior.ColorIndex = 6
[B2:J10].Font.Bold = False
[B2:J10].Font.ColorIndex = xlAutomatic
ActiveCell.Font.Bold = True
ActiveCell.Font.ColorIndex = 3
Else
[B2:J10].Font.ColorIndex = xlAutomatic
Range(ActiveCell.Address, ActiveCell.Offset(0, -Dl).Address).Interior.ColorIndex = 4
Range(ActiveCell.Address, ActiveCell.Offset(-Dc, 0).Address).Interior.ColorIndex = 4
End If
End If

End Sub

Cdlt

@kiss6

Mimimathy · Septembre 13, 2018, 4:02

Bonjour Kiss

If Not Application.Intersect(Target, [B2:J10]) Is Nothing Then

'Là tu ôtes les couleurs de B2 à J10, mais si la plage augmente le J10 n’est plus bon
[B2:J10].Interior.ColorIndex = xlNone

'Là tu colorises toutes les cellules en blanc
Cells.Interior.ColorIndex = 0

'Ici tu colorises depuis la cellule cliquée jusqu’à la cellule cliquée décalée de 8 lignes et 8 colonnes ??
'De plus sans condition
Range(ActiveCell.Address, ActiveCell.Offset(8, 8).Address).Interior.ColorIndex = 4
Range(ActiveCell.Address, ActiveCell.Offset(8, 8).Address).Interior.ColorIndex = 4

Regarde un peu mes indications dans le dernier post pour MDO

kiss6 · Septembre 14, 2018, 8:03

Re, @Mimimathy

j’ais beau regarder vos indication sur le post @mdo100 mais j’en perd mon latin c’est quand même compliqué

ce sacré VBA surtout a mon niveau ZERO

Mais je ne baisse pas les bras et @mdo100 n’a pas trouvé non plus ???

Cdlt

@kiss6

kiss6 · Septembre 14, 2018, 8:22

Re, @Mimimathy

Dite moi si je ne suis pas loin de la vérité

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Dl%, Dc%

Dl = ActiveCell.Column - 1 'Derniere colonne
Dc = ActiveCell.Row - 1 'Derniere ligne

If Not Application.Intersect(Target, [B2:J10]) Is Nothing Then
[B2:J10].Interior.ColorIndex = xlNone
Cells.Interior.ColorIndex = 0
With ActiveCell
Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row + Dl, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)).Interior.ColorIndex = 8
Range(Cells(.CurrentRegion.Row, .Column), Cells(.CurrentRegion.Rows.Count + .CurrentRegion.Row + -1, .Column)).Interior.ColorIndex = 8
End With
If ActiveCell.Value <> “” Then
Range(ActiveCell.Address, ActiveCell.Offset(0, -Dl).Address).Interior.ColorIndex = 6
Range(ActiveCell.Address, ActiveCell.Offset(-Dc, 0).Address).Interior.ColorIndex = 6
[B2:J10].Font.Bold = False
[B2:J10].Font.ColorIndex = xlAutomatic
ActiveCell.Font.Bold = True
ActiveCell.Font.ColorIndex = 3
Else
[B2:J10].Font.ColorIndex = xlAutomatic
Range(ActiveCell.Address, ActiveCell.Offset(0, -Dl).Address).Interior.ColorIndex = 4
Range(ActiveCell.Address, ActiveCell.Offset(-Dc, 0).Address).Interior.ColorIndex = 4
End If

End If

End Sub

Cdlt

@kiss6