Changement de couleur de police ligne aléatoire

Galaktus

XLDnaute Nouveau
Bonsoir le forum :)
Deux petite question rapide, je possède un tableau qui s'étend de "A1 à E13"
Sur l'onglet de ce tableau tourne un code qui permet avec un double-clic sur la valeur de la colonne "A" désiré de passer cette valeur en couleur de police rouge et de la repassé en noir en double-cliquant à nouveau dessus
Premiere question : comment modifier le code pour qu'il passe en rouge non pas la cellule mais la ligne du tableau en entier

Deuxieme question : comment incrémenter la valeur d'une cellule de "+ 1" pour qu'une cellule qui contient "N°1" passe à "N°2","N°3" et ainsi de suite

Je vous joint le code :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Not Intersect(Target, Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
If Target.Font.Color = RGB(255, 0, 0) Then
Target.Font.Color = RGB(0, 0, 0)
Else
Target.Font.Color = RGB(255, 0, 0)
End If
End If
End Sub

Merci d'avance à ceux qui voudrait m'aider
 
Dernière édition:

Papou-net

XLDnaute Barbatruc
Il te suffit de remplacer "Target" par "ActiveCell" dans le code du bouton OUI:

Private Sub CommandButton1_Click()
If Not Intersect(ActiveCell, Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
If ActiveCell.Font.Color = RGB(255, 0, 0) Then
Range("A" & ActiveCell.Row & ":E" & ActiveCell.Row).Font.Color = RGB(0, 0, 0)
Range("E" & ActiveCell.Row) = "N°" & Replace(Range("E" & ActiveCell.Row), "N°", "") + 1
ActiveCell.Offset(0, 5).Value = Now
Else
Range("A" & ActiveCell.Row & ":E" & ActiveCell.Row).Font.Color = RGB(255, 0, 0)
ActiveCell.Offset(0, 5).Value = Now
End If
End If
End Sub


PS: Target est une variable limitée à Feuil4

Cordialement.
 

Papou-net

XLDnaute Barbatruc
RE

Sinon, pour revenir à la solution sans formulaire:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Not Intersect(Target, Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
If MsgBox("Voulez-vous mettre le montage [" & Target.Offset(, 2) & "] en état de casse ?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
If Target.Font.Color = RGB(255, 0, 0) Then
Range("A" & Target.Row & ":E" & Target.Row).Font.Color = RGB(0, 0, 0)
Range("E" & Target.Row) = "N°" & Replace(Range("E" & Target.Row), "N°", "") + 1
Else
Range("A" & Target.Row & ":E" & Target.Row).Font.Color = RGB(255, 0, 0)
Target.Offset(, 5) = Now
End If
End If
End Sub


Par contre, le type de montage ne sera pas encadré (mais le code s'en trouve simplifié).

Cordialement.
 

Galaktus

XLDnaute Nouveau
Re Papou-net :)

Je te remercie, les deux codes fonctionnent à merveille, je suis content :)

Merci encore pour ton aide, le fichier fait exactement tout ce que je voulais
Désolé encore de cette ajout tardif, je te souhaite une bonne soirée et une bonne continuation
 

Discussions similaires

Réponses
0
Affichages
83
Réponses
2
Affichages
110

Statistiques des forums

Discussions
311 733
Messages
2 082 015
Membres
101 868
dernier inscrit
pierreselo33