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]

re,

excuse moi, je me suis trompé, car il ne me faut que 90 N° et donc il me faut 10 colonnes sur 9 lmignes.
merci

[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 = 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]

merci beaucoup,
c'est ce que je voulais
jacky

[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

[jacfld49]

Bonjour le forum, Mercatog,

cela fonctionne nickel, j'aurais une dernière chose, car j'ai le click qui me met la cellule en rouge avec police blanche, le click droit me remet la cellule en Noir et la police en blanc, et j'avais gardé ce code

Code :

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

1
2
3
4
Private Sub Noir_Click()
Range("M3:V11").Font.ColorIndex = xlNone
Range("M3:V11").Interior.ColorIndex = 1
End Sub

Pour remettre le fond en noir et la police enblanc, mais il me remet bien sur tout le tableau puique c'est ce qu'on lui demande; est il possible de ne remettre en fon noir et police blanche que les cellules sur lequel on a cliquée pour mettre le fond en rouge et la police en blanc.
merci
jacky

[mercatog]

Bonjour,
déjà je crois que tu peux t'ensortir

Code :

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

1
2
3
4
5
6
7
8
Private Sub Noir_Click()
Dim c As Range
For Each c In Range("M3:V11")
    If c.Font.ColorIndex = 2 And c.Interior.ColorIndex = 3 Then
        c.Interior.ColorIndex = 1
    End If
Next c
End Sub

[jacfld49]

RE,

merci beaucoup, cela fonctionne impeccable.
J'ai une autre question car le fichier, servira pour un LOTO et lorsqu'un N° sort, on doit l'annoncer , alors lorsqu'il y en a beaucoup,c'est dur de s'y retouver.
Ma question peut-on à partir du code TIRER,

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 [M2].Value = 90 Then Exit Sub
   Do
      i = Int(10 * Rnd): j = Int(10 * Rnd)
   Loop While IsEmpty([B4].Offset(i, j))
   [M2].Value = 1 + [M2].Value
   With [O4].Offset(i, j)
        .Value = [B4].Offset(i, j).Value
        .Font.ColorIndex = 2
        .Interior.ColorIndex = 1
   End With
   [B4].Offset(i, j) = Empty
End Sub

remettre les N° sorti sur une colonne (AA ), les uns en dessous des autres.
Bien sur j'essaie de mon côté d'y arriver mais je bloque , je dois mal faire car j'ai des bugs.
merci
jacky

[jacfld49]

re,

et bien sur dans ce code la pour réinitialiser le tout.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub initialiser()
Dim i As Integer, j As Integer
   Randomize
   Application.Calculation = xlManual
   Range("B4:K12,M2,O4:X12").ClearContents
   For i = 0 To 8
      For j = 0 To 9
         [B4].Offset(i, j) = 10 * i + j + 1
      Next j
   Next i
   Application.Calculation = xlAutomatic
End Sub

merci
jacky

[jacfld49]

re,

le mieux , plutot que ce soit sur une colonne, c'est qu'ils se remettent dans un autre tableau qui est en (AB4:AK12) et dans l'ordre de tirage.
J'ai déja ce code Tirer2

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub tirer2()
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

que je n'arrive pas à intégrer dans le code Tirer

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
Sub tirer()
Dim i As Integer, j As Integer
   If [M2].Value = 90 Then Exit Sub
   Do
      i = Int(10 * Rnd): j = Int(10 * Rnd)
   Loop While IsEmpty([B4].Offset(i, j))
   [M2].Value = 1 + [M2].Value
   With [O4].Offset(i, j)
        .Value = [B4].Offset(i, j).Value
        .Font.ColorIndex = 2
        .Interior.ColorIndex = 1
   End With
   With [AA4].Offset(i)
        .Value = [B4].Offset(i)
   End With
   [B4].Offset(i, j) = Empty
End Sub

mais qui met en 9 colonnes sur 11 lignes alors qu'il faut qu'ils semettent comme l'autre tableau en 10 colonnes et 9 lignes
merci
jacky

[mercatog]

Re,
2 sujets différents en un seul, ça risque de perturber

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
Sub tirer()
Dim i As Integer, j As Integer
   If [M2].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
   With [M3].Offset(i, j)
        .Value = [B3].Offset(i, j).Value
        .Font.ColorIndex = 2
        .Interior.ColorIndex = 1
    End With
   [AA100].End(xlUp).Offset(1, 0).Value = [B3].Offset(i, j).Value
   [B3].Offset(i, j) = Empty
End Sub