Changement de couleur de police ligne aléatoire

[Galaktus]

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

 

[Papou-net]

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]

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

 

[eriiic]

Bonjour,

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

"N° "0

pour lire N° 1
eric

 

[Papou-net]

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]

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

 

[eriiic]

Bonjour,

Papou-net avait oublié que tu double-cliques en A mais que c'est E qu'il faut incrémenter.
Faire .offset(,4)
Fichier avec ma proposition.

 

[Papou-net]

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]

Bonjour à tous

Une autre manière d'écrire la macro.
Normalement, ça donne le même résultat

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...]

Bon_jour

ou encore

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]

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]

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]

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]

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.

 

[Galaktus]

Voila ci-joint Papou-net