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
Bonsoir Galaktus,

Essaie comme ceci:

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
Range("A" & Target.Row & ":E" & Target.Row).Font.Color = RGB(0, 0, 0)
Target = Target + 1
Else
Range("A" & Target.Row & ":E" & Target.Row).Font.Color = RGB(255, 0, 0)
End If
Target = Target + 1
End If
End Sub

Cordialement.
 

Galaktus

XLDnaute Nouveau
Bonsoir Papou-net merci pour ta réponse rapide

Ton code fonctionne à merveille pour sélectionner a ligne entière :)

Pour la partie "Target = Target + 1" excel me donne l'erreur incompatibilité de type, la cellule à incrementer contient "N°1", cependant j'ai reessayé en mettant seulement "1" mais il me renvoi la meme erreur

Bonne nuit ou bonne journée à toi selon quand tu liras ce message :)
 

eriiiic

XLDnaute Barbatruc
Bonjour,

ce n'est pas "1" qu'il faut mettre (c'est du texte), mais 1 (nombre).
Et tu peux ajouter en format personnalisé :
Code:
"N° "0
pour lire N° 1
eric
 

Papou-net

XLDnaute Barbatruc
Bonjour Eric,
Bonjour Galaktus,

Ou bien:

Target = "N°" & Replace(Target.Value, "N°", "") + 1

La solution d'Eric est plus simple, mais peut-être que le format personnalisé ne doit pas s'appliquer sur l'ensemble des colonnes.

Bonne journée.

Cordialement.
 

Galaktus

XLDnaute Nouveau
Bonjour Papou-net
bonjour Eric

J'ai essayé les deux solutions et les deux me rapportent l'erreur "incompatibilité de type", il ya quelque chose que je fais mal c'est sur
Je vous joint le fichier après avoir enlevé toute les données confidentielles ca sera plus simple, désolé de ne pas l'avoir fait tout de suite

Bonne journée à vous :)
 

Fichiers joints

Papou-net

XLDnaute Barbatruc
RE:

Voici le code corrigé:

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
Range("A" & Target.Row & ":E" & Target.Row).Font.Color = RGB(0, 0, 0)
Else
Range("A" & Target.Row & ":E" & Target.Row).Font.Color = RGB(255, 0, 0)
End If
Range("E" & Target.Row) = "N°" & Replace(Range("E" & Target.Row), "N°", "") + 1
End If
End Sub


Cordialement.
 

Yurperqod

XLDnaute Occasionnel
Bonjour à tous

Une autre manière d'écrire la macro.
Normalement, ça donne le même résultat
VB:
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.Resize(, 5).Font.Color = RGB(0, 0, 0)
Else
Target.Resize(, 5).Font.Color = RGB(255, 0, 0)
End If
  With Cells(Target.Row, 5)
  .Value = Cells(Target.Row, 5) + 1
  .NumberFormat = """N°""General"
  End With
End If
End Sub
 

Si...

XLDnaute Barbatruc
Bon_jour

ou encore
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Oust As Boolean)
    If Intersect(R, Range("A3", [A6500].End(xlUp))) Is Nothing Or R = "" Then Exit Sub
    Oust = 1
    R.Resize(, 5).Font.Color = IIf(R.Font.Color = vbRed, vbBlack, vbRed)
    R(1, 5) = R(1, 5) + 1
End Sub
en évitant les cellules vides et sans les .Offset mais avec des cellules en colonne E déjà formatées.
 

Galaktus

XLDnaute Nouveau
Bonjour à tout le monde :)
Bonjour papou-net et Eric

Merci beaucoup les codes fonctionne à merveille

Je veux pas abuser mais j'aurais encore une question, en fait c'est un fichier qui va servir à beaucoup d'utilisateur (qui pour beaucoup ne sont pas à l'aise avec l'informatique)
En l'essayant je me suis rendu compte que le déroulement serait plus propre si après que je double-clique sur une cellule de la colonne "A" une userform s'ouvre avec le choix "oui" ou "non" pour continuer ou arreter la macro
J'ai crée l'userform et les boutons mais le code transposer tel quel sur le bouton "oui" ne fonctionne plus

Qu'elle partie du code faudrait t'il modifié?
L'userform s'appelle "userform1"

Désolé encore pour cette ajout imprévu
 

Papou-net

XLDnaute Barbatruc
RE

Pas besoin de créer unUserForm, un simple MsgBox suffit:

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("Continuer ?", 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)
Else
Range("A" & Target.Row & ":E" & Target.Row).Font.Color = RGB(255, 0, 0)
End If
End If
Target.Offset(, 4) = Target.Offset(, 4) + 1
End Sub


Cordialement.
 

Galaktus

XLDnaute Nouveau
En fait je me sers de l'userform pour y inclure aussi dans un label la valeur de la cellule ou j'ai double-cliqué
 

Papou-net

XLDnaute Barbatruc
RE

Alors peut-être comme ceci:

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("Continuer avec " & Target.Address & " ?", 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)
Else
Range("A" & Target.Row & ":E" & Target.Row).Font.Color = RGB(255, 0, 0)
End If
End If
Target.Offset(, 4) = Target.Offset(, 4) + 1
End Sub


Sinon, envoie ton fichier avec l'Userform en question (rappelle-toi que tu as regretté de ne pas l'avoir fait plus tôt!).

Cordialement.
 

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


Haut Bas