Discussion :

[jacfld49]

Bonsoir le forum,

Voila j'ai un tableau (L3:T13) ou l'écriture est en Noir, je voudrais appliquer à l'aide d'une macro, en cliquant sur une cellule de ce tableau une couleur de police Rouge et ensuite a l'aide d'un bouton pouvoir réinitialiser .
merci et espère avoir été clair.
jacky

[mercatog]

Bonsoir Jacky,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("L3:T13")) Is Nothing Then
    If Target.Cells.Count = 1 Then
        If Target.Font.ColorIndex <> 3 Then Target.Font.ColorIndex = 3
    End If
End If
End Sub
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("L3:T13")) Is Nothing Then
    Cancel = True
    If Target.Cells.Count = 1 Then
        If Target.Font.ColorIndex <> 1 Then Target.Font.ColorIndex = 1
    End If
End If
End Sub

sélection en rouge
clique droit en noir

[jacfld49]

bonsoir Mercatog,

C'est génial, la seule chose, c'est pour la remise à la couleur initial, je préfèrerai un bouton car comme c'est pour un loto, il peut y avoir jusqu'a 15 N° de tiré et s'il faut recliquer 1 par 1,cela risque d'être long.
Merci encore de ton aide
jacky

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
private sub commandbutton_click()
Range("L3:T13").Font.ColorIndex = 1
end sub

ou mieux, toujours clique droit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("L3:T13")) Is Nothing Then
    Cancel = True
    Range("L3:T13").Font.ColorIndex = 1
End If
End Sub

[jacfld49]

RE?
MERCI, C'EST NICKEL COMME ça.
J'ai une autre question, comme j'ai un tableau en B3:J13 qui recopie grace à un bouton tiré les N° sortie dans le tableau L3:T13; le problème, c'est que les tableaux ont 9 colonnes et 11 lignes (c'est à dire 1ère ligne, N° 1 à 9 , 2ème Ligne,N° 10 à 18) alors que j'aimerais que les tableaux ont 10 colonnes et 10 lignes et que les lignes soient rempli par dizaines (1 à 10, 11 à 20 etc...).
Je joint les codes 2 codes des macros pour voir ce qu'il faut changer .
Merci d'avance.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub tirer()
Dim i As Integer, j As Integer
   If [K2].Value = 99 Then Exit Sub
   Do
      i = Int(12 * Rnd): j = Int(10 * Rnd)
   Loop While IsEmpty([B3].Offset(i, j))
   [K2].Value = 1 + [K2].Value
   [L3].Offset(i, j).Value = [B3].Offset(i, j).Value
   [B3].Offset(i, j) = Empty
End Sub
 
Sub initialiser()
Dim i As Integer, j As Integer
   Randomize
   Application.Calculation = xlManual
   Range("B3:J13,K2,L3:T13").ClearContents
   For i = 0 To 10
      For j = 0 To 8
         [B3].Offset(i, j) = 9 * i + j + 1
      Next j
   Next i
   Application.Calculation = xlAutomatic
End Sub

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub tirer()
Dim i As Integer, j As Integer
   If [L2].Value = 100 Then Exit Sub
   Do
      i = Int(11 * Rnd): j = Int(11 * Rnd)
   Loop While IsEmpty([B3].Offset(i, j))
   [L2].Value = 1 + [L2].Value
   [M3].Offset(i, j).Value = [B3].Offset(i, j).Value
   [B3].Offset(i, j) = Empty
End Sub
 
Sub initialiser()
Dim i As Integer, j As Integer
   Randomize
   Application.Calculation = xlManual
   Range("B3:K12,L2,M3:V13").ClearContents
   For i = 0 To 9
      For j = 0 To 9
         [B3].Offset(i, j) = 10 * i + j + 1
      Next j
   Next i
   Application.Calculation = xlAutomatic
End Sub

[jacfld49]

Bonsoir,

Que faut il ajouter au code pour que le fond de cellule se mette en Noir et la police en Blanc
merci d'avance
jacky

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub tirer()
Dim i As Integer, j As Integer
   If [L2].Value = 90 Then Exit Sub
   Do
      i = Int(10 * Rnd): j = Int(11 * Rnd)
   Loop While IsEmpty([B3].Offset(i, j))
   [L2].Value = 1 + [L2].Value
   [M3].Offset(i, j).Value = [B3].Offset(i, j).Value
   [B3].Offset(i, j) = Empty
End Sub
 
Sub initialiser()
Dim i As Integer, j As Integer
   Randomize
   Application.Calculation = xlManual
   Range("B3:K11,L2,M3:V11").ClearContents
   For i = 0 To 8
      For j = 0 To 9
         [B3].Offset(i, j) = 10 * i + j + 1
      Next j
   Next i
   Application.Calculation = xlAutomatic
End Sub

[jacfld49]

re,

et donc dans ce code, que faut il rajouter pour mettre le fond de Cellule en rouge et l'écriture en Blanc

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("L3:T13")) Is Nothing Then
    If Target.Cells.Count = 1 Then
        If Target.Font.ColorIndex <> 3 Then Target.Font.ColorIndex = 3
    End If
End If
End Sub

et dans celui ci pour remettre en noir le fond de cellule et en blanc la couleur de police

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("L3:T13")) Is Nothing Then
    Cancel = True
    Range("L3:T13").Font.ColorIndex = 1
End If
End Sub

et aussi dans celui ci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
private sub commandbutton_click()
Range("L3:T13").Font.ColorIndex = 1
end sub

merci
jacky

[mercatog]

Bonsoir

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("L3:T13")) Is Nothing Then
    If Target.Cells.Count = 1 Then
        Target.Font.ColorIndex = 2
        Target.Interior.ColorIndex = 3
    End If
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("L3:T13")) Is Nothing Then
    Cancel = True
    Range("L3:T13").Font.ColorIndex = 1
    Range("L3:T13").Interior.ColorIndex = xlNone
End If
End Sub

[jacfld49]

re,

avec ce code, le clic droit réinitialise toutes les cellules, je voudrais que le clic réinitialise seulement la cellule sur lequel on clic droite

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("M3:V11")) Is Nothing Then
    Cancel = True
    Range("M3:V11").Font.ColorIndex = xlNone
    Range("M3:V11").Interior.ColorIndex = 1
End If
End Sub

et que faut il ajouter dans ces codes pour que les cellules se mettent en fond noir et police blanche

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub tirer()
Dim i As Integer, j As Integer
   If [L2].Value = 90 Then Exit Sub
   Do
      i = Int(10 * Rnd): j = Int(10 * Rnd)
   Loop While IsEmpty([B3].Offset(i, j))
   [L2].Value = 1 + [L2].Value
   [M3].Offset(i, j).Value = [B3].Offset(i, j).Value
   [B3].Offset(i, j) = Empty
End Sub
 
Sub initialiser()
Dim i As Integer, j As Integer
   Randomize
   Application.Calculation = xlManual
   Range("B3:K12,L2,M3:V13").ClearContents
   For i = 0 To 8
      For j = 0 To 9
         [B3].Offset(i, j) = 10 * i + j + 1
      Next j
   Next i
   Application.Calculation = xlAutomatic
End Sub

merci de ton aide
jacky

[mercatog]

suivre la même logique, le Target est le range sélectionné (ou la cellule où on double clique)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("L3:T13")) Is Nothing Then
    If Target.Cells.Count = 1 Then
        Target.Font.ColorIndex = 2
        Target.Interior.ColorIndex = 3
    End If
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("L3:T13")) Is Nothing Then
    Cancel = True
    Target.Font.ColorIndex = 1
    Target.Interior.ColorIndex = xlNone
End If
End Sub

et ensuite pour la 2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub tirer()
Dim i As Integer, j As Integer
   If [L2].Value = 90 Then Exit Sub
   Do
      i = Int(10 * Rnd): j = Int(10 * Rnd)
   Loop While IsEmpty([B3].Offset(i, j))
   [L2].Value = 1 + [L2].Value
   With [M3].Offset(i, j)
        .Value = [B3].Offset(i, j).Value
        .Font.ColorIndex = 2
        .Interior.ColorIndex = 3
   End with
   [B3].Offset(i, j) = Empty
End Sub