XL 2016 problème code vba

harveyspecter

XLDnaute Occasionnel
Bonjour,

J'ai ci-joint un code vba permettant de colorier la colonne et la ligne des que je clique sur une cellule.

Le problème c'est que si je mets de la couleur en titre ou sur des autres étiquette, il me les effaces.

Comment lui dire de ne pas toucher au cellule déjà colorier ?

merci

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)



'------------------------------------------------------------

Cells.Interior.ColorIndex = xlColorIndexNone

'------------------------------------------------------------


ActiveCell.EntireColumn.Interior.ColorIndex = 19 'Column Color

ActiveCell.EntireRow.Interior.ColorIndex = 19 ' Row Color

ActiveCell.Cells.Interior.ColorIndex = 44 ' Cell Color


'------------------------------------------------------------
 

Pièces jointes

  • couleur colonne ligne interieur.xls
    54.5 KB · Affichages: 2

GALOUGALOU

XLDnaute Accro
re harveyspecter
votre classeur est protégé, donc les codes sont non visibles pour les membres du forum.
à partir de votre code du #1, une possibilité, utiliser la méthode intersect pour définir une zone d'action sur le clic. (ex pour b4:n30)
If Not Application.Intersect(Target, Range("B4:N30")) Is Nothing Then

End If
définir des variables pour limiter l'action sur les lignes et les colonnes, ce qui pourrait donner comme code
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim col As Integer
Dim lig As Integer
col = ActiveCell.Column
lig = ActiveCell.Row


If Not Application.Intersect(Target, Range("B4:N30")) Is Nothing Then


    Range("B4:N30").Interior.ColorIndex = xlColorIndexNone

        Range(Cells(4, col), Cells(30, col)).Interior.ColorIndex = 19 'Column Color

            Range(Cells(lig, 2), Cells(lig, 14)).Interior.ColorIndex = 19 ' Row Color

                ActiveCell.Cells.Interior.ColorIndex = 44 ' Cell Color

End If
End Sub
cdt
galougalou
 

Pièces jointes

  • colorier une plage de cellule.xlsm
    15.8 KB · Affichages: 4

soan

XLDnaute Barbatruc
Inactif
Bonjour harveyspecter, galougalou,

J'ai essayé ta réponse galougalou mais ça ne marche pas...

si tu as mis le code VBA de galougalou dans un module standard comme Module1, alors c'est normal que ça ne marche pas ; il faut mettre le code VBA dans le module de la feuille concernée ; par exemple si c'est pour "Feuil1", il faut mettre le code VBA dans le module de "Feuil1" ; dans ton projet VBA, côté gauche, au-dessus de ThisWorkbook, fais un double clic sur "Feuil1 (Feuil1)" (ou un seul clic puis Entrée) : tu seras au bon endroit. :)

s'il s'agit d'autre chose qui ne marche pas, tu dois indiquer au juste qu'est-ce qui ne va pas : si on ne sait pas ce qui cloche, on n'a aucune idée de ce qu'il faudrait faire pour l'arranger !​

soan
 

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Le problème c'est que si je mets de la couleur en titre ou sur des autres étiquette, il me les effaces.

Comment lui dire de ne pas toucher au cellule déjà colorier ?
Soit tu exclues la ligne de titre avec Not Application.Intersect(Target, Range("A2:K73")) de la macro qui fait le coloriage, soit tu ne fais pas un coloriage mais un "hachurage" des lignes et des colonnes (comme ça tu ne touches pas à la couleur de fond des cellules). ;)
 

TooFatBoy

XLDnaute Barbatruc
Je te propose une alternative :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim MaPlage As Range, MaLigne As Range, MaColonne As Range

    Set MaPlage = ActiveSheet.Range("A1:K73")

    With Cells.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With

    If Not Application.Intersect(Target, MaPlage) Is Nothing Then

        Set MaLigne = Intersect(Target.EntireRow, MaPlage)
        With MaLigne.Interior
            .Pattern = xlUp
            .PatternColor = 65535
        End With

        Set MaColonne = Intersect(Target.EntireColumn, MaPlage)
        With MaColonne.Interior
            .Pattern = xlUp
            .PatternColor = 65535
        End With

        With Target.Interior
            .Pattern = xlUp
            .PatternThemeColor = xlThemeColorAccent6
        End With

    End If

End Sub
 
Dernière édition:

TooFatBoy

XLDnaute Barbatruc
Et sinon, le code de #6 corrigé :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim col As Integer
Dim lig As Integer

    col = ActiveCell.Column
    lig = ActiveCell.Row

    If Not Application.Intersect(Target, Range("A1:K73")) Is Nothing Then
        Range("A1:K73").Interior.ColorIndex = xlColorIndexNone
        Range(Cells(1, col), Cells(73, col)).Interior.ColorIndex = 19
        Range(Cells(lig, 1), Cells(lig, 11)).Interior.ColorIndex = 19
        ActiveCell.Interior.ColorIndex = 44 '
    End If

End Sub
 
Dernière édition:

GALOUGALOU

XLDnaute Accro
bonjour le fil, salutation soan & toofatboy
allez je me suis amusé.
j'ai supposé que la ligne 1 était à coloriser, que la plage était égale à 200 lignes, mais tout cela est à discrétion de harveyspecter
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim col As Integer
Dim lig As Integer

col = ActiveCell.Column
lig = ActiveCell.Row

'définir la zone d'action

If Not Application.Intersect(Target, Range("A2:K200")) Is Nothing Then

'rétablir la couleur, police et cellule des cellules de A1 à K1

    With Range("A1:K1")
        .Interior.ColorIndex = 8
      .Font.ColorIndex = 1
    End With
  
    'supprime les couleurs de la zone A2 K200
    Range("A2:K200").Interior.ColorIndex = xlColorIndexNone
  
    'colorise de la 1er ligne à la ligne 200 sur la colonne active
        Range(Cells(1, col), Cells(200, col)).Interior.ColorIndex = 19 'Column Color
      
        'colorise de la colonne 1 à l colonne 11 sur la ligne active
            Range(Cells(lig, 1), Cells(lig, 11)).Interior.ColorIndex = 19 ' Row Color
          
            'colorise la cellule active
                ActiveCell.Cells.Interior.ColorIndex = 44 ' Cell Color

End If
End Sub

cdt
galougalou
 

Pièces jointes

  • couleur colonne ligne interieur V3.xls
    68 KB · Affichages: 3

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 944
Membres
101 849
dernier inscrit
florentMIG