Changer la mise en forme lorsqu'on sélectionne une cellule

Bonjour à tous.

Je vous explique mon problème.

Dans l'onglet "cl 1"

J'aimerai que les cellules de C18 à C47 changent de mise en forme automatiquement lorsque je sélectionne une cellules qui va de Y18 à NZ47.

Exemple : je sélectionne la cellule Y19 donc la cellule C19 change de mise en forme.

puis je sélectionne la cellule AA31 donc la cellule C31 change de mise en forme.

Comme mise en forme j'aimerai un agrandissement de la police et un changement de couleur de fond.

Merci pour votre aide.

Salut,

Voici un code - à placer dans le code de la feuille - qui devrait faire l'affaire :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Range("C18:C47").Interior.Pattern = xlNone
Range("C18:C47").Font.Size = 11

If Target.Count > 1 Then Exit Sub

Application.ScreenUpdating = False

    If Not Application.Intersect(Target, Range("Y18:NZ47")) Is Nothing Then
        Cells(Target.Row, 3).Interior.ColorIndex = 4
        Cells(Target.Row, 3).Font.Size = 14
    End If

End Sub

Cordialement.

Bonjour,

Un premier essai

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Plage As Range, c As Range
    Application.ScreenUpdating = False
    If Not Application.Intersect(Target, Range("Y18:NZ47")) Is Nothing Then
        Rows("18:47").RowHeight = 12
        Set Plage = Range("C18:C47")
        With Plage
            .Font.Size = 9
            .Interior.Color = xlNone
        End With
        Set c = Target.Offset(, -22)
        With c
            .Font.Size = 12
            .Interior.Color = 255
        End With
    Else
        Rows("18:47").RowHeight = 12
        Set Plage = Range("C18:C47")
        With Plage
            .Font.Size = 9
            .Interior.Color = xlNone
        End With
    End If
    Set Plage = Nothing: Set c = Nothing
End Sub

Yvouille a écrit :

Salut,

Voici un code - à placer dans le code de la feuille - qui devrait faire l'affaire :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Range("C18:C47").Interior.Pattern = xlNone
Range("C18:C47").Font.Size = 11

If Target.Count > 1 Then Exit Sub

Application.ScreenUpdating = False

    If Not Application.Intersect(Target, Range("Y18:NZ47")) Is Nothing Then
        Cells(Target.Row, 3).Interior.ColorIndex = 4
        Cells(Target.Row, 3).Font.Size = 14
    End If

End Sub

Cordialement.

Un grand merci.

Ca fait exactement ce que je voulais... le seul hic c'est que la macro rend le tout assez lent... mais ça fonctionne nickel.

Merci.

Jean-Eric a écrit :

Bonjour,

Un premier essai

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Plage As Range, c As Range
    Application.ScreenUpdating = False
    If Not Application.Intersect(Target, Range("Y18:NZ47")) Is Nothing Then
        Rows("18:47").RowHeight = 12
        Set Plage = Range("C18:C47")
        With Plage
            .Font.Size = 9
            .Interior.Color = xlNone
        End With
        Set c = Target.Offset(, -22)
        With c
            .Font.Size = 12
            .Interior.Color = 255
        End With
    Else
        Rows("18:47").RowHeight = 12
        Set Plage = Range("C18:C47")
        With Plage
            .Font.Size = 9
            .Interior.Color = xlNone
        End With
    End If
    Set Plage = Nothing: Set c = Nothing
End Sub

Merci pour la proposition.

Malheureusement ça fonctionne uniquement pour la première colonne.

Salut,

DJICI a écrit :

le seul hic c'est que la macro rend le tout assez lent... mais ça fonctionne nickel

Dans quelles opérations te rends-tu comptes de cette lenteur ? Lorsque cette macro est déclenchée automatiquement par la sélection d’une nouvelle cellule ou lors d’autres opérations ?

Dans le fichier tel que fourni, si je change de sélection, ma macro dure une fraction de seconde.

A te relire.