Mettre la case en fond rouge ecriture blanche

Le 12/07/2018 à 13:18

j'ai créé un code mais je ne sais pas comment mettre la case rouge ecriture blanche

merci

Sub ep2019_33100()
'equipe A
Dim plage1 As Range, plage2 As Range, jour, c As Range, j As Variant
Set plage1 = [[Planning_ep.xlsm]ep2019!F7:BE7]
Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5
jour = Array("jeu") 'liste à adapter
With Application
    .ScreenUpdating = False
    Range("C13:NC13").ClearContents
    For Each c In Range("C13:NC13")
        If UCase(c.Offset(-8)) = "A" Then 'M,A,N
            If IsNumeric(.Match(c.Offset(-11), jour, 0)) Then
                i = .Match(c.Offset(-10), plage2)
                If IsNumeric(i) Then If UCase(plage1(i)) = "A" Then c = 6 'equipe
            End If
        End If
    Next
End With
Le 12/07/2018 à 13:37

Bonjour,

si j'ai bien compris votre demande, vous pouvez ajouter ces lignes de codes là où bon vous semble :

 
Range(c).Select
Selection.Interior.Color = 255
Selection.Font.ThemeColor = xlThemeColorDark1

Cindy

Le 12/07/2018 à 14:38

ca ne marche pas

Le 12/07/2018 à 14:40

Où l'avez-vous placé dans votre code?

Cindy

Le 12/07/2018 à 14:44

Sub ep2019_33100()

'equipe A

Dim plage1 As Range, plage2 As Range, jour, c As Range, j As Variant

Set plage1 = [[Planning_ep.xlsm]ep2019!F7:BE7]

Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5

jour = Array("jeu") 'liste à adapter

With Application

.ScreenUpdating = False

Range("C13:NC13").ClearContents

For Each c In Range("C13:NC13")

If UCase(c.Offset(-8)) = "A" Then 'M,A,N

If IsNumeric(.Match(c.Offset(-11), jour, 0)) Then

i = .Match(c.Offset(-10), plage2)

If IsNumeric(i) Then If UCase(plage1(i)) = "A" Then c = 6 'equipe

Range(c).Select

Selection.Interior.Color = 255

Selection.Font.ThemeColor = xlThemeColorDark1

End If

End If

Next

End With

Le 12/07/2018 à 15:07

Est-il possible de m'envoyer votre fichier Excel ?

Cindy

Le 12/07/2018 à 16:05

je peux pas car la macro marche avec un fichier réseau qui me met un 6 dans une case

je veux juste mettre la case en font rouge écriture blanche quand il y a marquer 6

Le 12/07/2018 à 16:15

Pouvez-vous essayer :

c.Select
Selection.Interior.Color = 255
Selection.Font.ThemeColor = xlThemeColorDark1

Cindy

Le 12/07/2018 à 17:40

j'ai mis ca

met ca me met la case en rouge meme quand il y a pas de 6 ci joint la photo

Sub ep2019_33100()
'equipe A
Dim plage1 As Range, plage2 As Range, jour, c As Range, j As Variant
Set plage1 = [[Planning_ep.xlsm]ep2019!F7:BE7]
Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5
jour = Array("jeu") 'liste à adapter
With Application
    .ScreenUpdating = False
    Range("C13:NC13").ClearContents
    For Each c In Range("C13:NC13")
        If UCase(c.Offset(-8)) = "A" Then 'M,A,N
            If IsNumeric(.Match(c.Offset(-11), jour, 0)) Then
                i = .Match(c.Offset(-10), plage2)
                If IsNumeric(i) Then If UCase(plage1(i)) = "A" Then c = 6 'equipe
             c.Select
Selection.Interior.Color = 255
Selection.Font.ThemeColor = xlThemeColorDark1

            End If
capture
Le 12/07/2018 à 17:47

Il vous manque un "end if" :

Sub ep2019_33100()
'equipe A
Dim plage1 As Range, plage2 As Range, jour, c As Range, j As Variant
Set plage1 = [[Planning_ep.xlsm]ep2019!F7:BE7]
Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5
jour = Array("jeu") 'liste à adapter
With Application
    .ScreenUpdating = False
Range("C13:NC13").ClearContents
For Each c In Range("C13:NC13")
        If UCase(c.Offset(-8)) = "A" Then 'M,A,N
            If IsNumeric(.Match(c.Offset(-11), jour, 0)) Then
                i = .Match(c.Offset(-10), plage2)
                If IsNumeric(i) Then
                    If UCase(plage1(i)) = "A" Then
                        c = 6 'equipe
                         c.Select
                Selection.Interior.Color = 255
                Selection.Font.ThemeColor = xlThemeColorDark1
             End if
                End If
     End if
Next
Le 12/07/2018 à 17:48

Pardon, il en manque encore 1 :

Sub ep2019_33100()
'equipe A
Dim plage1 As Range, plage2 As Range, jour, c As Range, j As Variant
Set plage1 = [[Planning_ep.xlsm]ep2019!F7:BE7]
Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5
jour = Array("jeu") 'liste à adapter
With Application
    .ScreenUpdating = False
Range("C13:NC13").ClearContents
For Each c In Range("C13:NC13")
    If UCase(c.Offset(-8)) = "A" Then 'M,A,N
                If IsNumeric(.Match(c.Offset(-11), jour, 0)) Then
                    i = .Match(c.Offset(-10), plage2)
                    If IsNumeric(i) Then
                        If UCase(plage1(i)) = "A" Then
                            c = 6 'equipe
                             c.Select
                    Selection.Interior.Color = 255
                    Selection.Font.ThemeColor = xlThemeColorDark1
                 End if
                    End If
         End if
    End if
Next
Le 12/07/2018 à 18:01

j'ai une erreur de bloc

Sub ep2019_33100()
'equipe A
Dim plage1 As Range, plage2 As Range, jour, c As Range, j As Variant
Set plage1 = [[Planning_ep.xlsm]ep2019!F7:BE7]
Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5
jour = Array("jeu") 'liste à adapter
With Application
    .ScreenUpdating = False
    Range("C13:NC13").ClearContents
    For Each c In Range("C13:NC13")
        If UCase(c.Offset(-8)) = "A" Then 'M,A,N
            If IsNumeric(.Match(c.Offset(-11), jour, 0)) Then
                i = .Match(c.Offset(-10), plage2)
                If IsNumeric(i) Then If UCase(plage1(i)) = "A" Then c = 6 'equipe
            c.Select
                Selection.Interior.Color = 255
                Selection.Font.ThemeColor = xlThemeColorDark1
            End If
                End If
    End If
Next
End With
end sub
Le 12/07/2018 à 18:05

Essayez de copier coller le dernier code que je vous ai envoyé, avec les retours à la ligne comme je vous l'ai indiqué.

Cindy

Le 12/07/2018 à 18:07

j'avais ecrit ca

Sub ep2019_33100()
'equipe A
Dim plage1 As Range, plage2 As Range, jour, c As Range, j As Variant
Set plage1 = [[Planning_ep.xlsm]ep2019!F7:BE7]
Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5
jour = Array("jeu") 'liste à adapter
With Application
    .ScreenUpdating = False
    Range("C13:NC13").ClearContents
    For Each c In Range("C13:NC13")
        If UCase(c.Offset(-8)) = "A" Then 'M,A,N
            If IsNumeric(.Match(c.Offset(-11), jour, 0)) Then
                i = .Match(c.Offset(-10), plage2)
                If IsNumeric(i) Then If UCase(plage1(i)) = "A" Then c = 6 'equipe
             c.Select
Selection.Interior.Color = 255
Selection.Font.ThemeColor = xlThemeColorDark1

            End If
  End If

Next
End With
end sub
Le 12/07/2018 à 18:14
Sub ep2019_33100()
'equipe A
Dim plage1 As Range, plage2 As Range, jour, c As Range, j As Variant
Set plage1 = [[Planning_ep.xlsm]ep2019!F7:BE7]
Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5
jour = Array("jeu") 'liste à adapter
With Application
    .ScreenUpdating = False
Range("C13:NC13").ClearContents
For Each c In Range("C13:NC13")
    If UCase(c.Offset(-8)) = "A" Then 'M,A,N
                If IsNumeric(.Match(c.Offset(-11), jour, 0)) Then
                    i = .Match(c.Offset(-10), plage2)
                    If IsNumeric(i) Then
                        If UCase(plage1(i)) = "A" Then
                            c = 6 'equipe
                             c.Select
                    Selection.Interior.Color = 255
                    Selection.Font.ThemeColor = xlThemeColorDark1
                 End if
                    End If
         End if
    End if
Next
End with
End sub
Le 12/07/2018 à 18:28

super ca marche

Rechercher des sujets similaires à "mettre case fond rouge ecriture blanche"