Couleur + code couleur

amoadam

XLDnaute Nouveau
Bonjour à toutes et tous,
J'ai joint un fichier dans lequel je souhaite non seulement colorer les lignes (entre B et N) de la couleur des boutons de la boite à outil qui s'active en appuyant sur le bouton bleu en A2 mais je souhaiterai également que cela écrive un code en A correspondant aux lignes sélectionnées.
Quand je sélectionne une cellule (n'importe laquelle) puis que je clique sur la couleur désirée, ça fonctionne. Par contre quand je veux en sélectionner plusieures (sur plusieurs lignes), ça colore mais le code ne s'inscrit que sur la première lignes (où la cellule est active).

J'espère être suffisamment compréhensible !! ;-)

Merci de votre aide.

Amo.
 

Pièces jointes

  • test.xlsm
    24.2 KB · Affichages: 40
  • test.xlsm
    24.2 KB · Affichages: 43
  • test.xlsm
    24.2 KB · Affichages: 45

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Couleur + code couleur

Bonjour amoadam et birnvenue sur XLD :) ,

Un essai dans le fichier joint. Cela devrait fonctionner à partir de n'importe quelle sélection de cellules (une cellule, plusieurs cellules contigües ou non , plusieurs zones contigües ou non au sein du tableau).

Un exemple de code utilisé:
VB:
Sub horaire_non_respecte()
  Dim xZone As Range, xLigne As Range
  For Each xZone In Selection.Areas
    For Each xLigne In xZone.Rows
      Cells(xLigne.Row, "a") = 2
      With Cells(xLigne.Row, "b").Resize(, 13).Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .Color = 65535
          .TintAndShade = 0
          .PatternTintAndShade = 0
      End With
    Next xLigne
  Next xZone
  Cells(Selection.Row, 2).Select
End Sub
 

Pièces jointes

  • amoadam test v1.xlsm
    26.3 KB · Affichages: 33
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Couleur + code couleur

Re,

Un essai avec beaucoup moins de code: une seule procédure avec paramètre, la ligne prend la couleur du bouton cliqué.

Le code de la procédure:
VB:
Sub CodeCouleur(Cod, coul)
Dim xZone As Range
  Application.ScreenUpdating = False
  For Each xZone In Selection.Areas
    xZone.EntireRow.Columns(1).Value = Cod
    xZone.EntireRow.Columns(2).Resize(, 13).Interior.Color = coul
  Next xZone
  Cells(Selection.Row, 2).Select
  Application.ScreenUpdating = True
End Sub

Le code d'un bouton :
VB:
Private Sub CommandButton1_Click()
  CodeCouleur 2, CommandButton1.BackColor
End Sub

sauf bouton2:
VB:
Private Sub CommandButton2_Click()
  CodeCouleur 1, xlColorIndexNone
End Sub
 

Pièces jointes

  • amoadam test v2.xlsm
    24.1 KB · Affichages: 24

Statistiques des forums

Discussions
312 505
Messages
2 089 096
Membres
104 030
dernier inscrit
Angy