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 :)
 

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 :)
 

Pièces jointes

  • Gestion %2B inventaire outillage v3.xlsm
    16.6 KB · Affichages: 17

eriiic

XLDnaute Barbatruc
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.
 

Pièces jointes

  • Gestion %2B inventaire outillage v3.xlsm
    17.8 KB · Affichages: 24

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.
 

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.
 

Discussions similaires

Réponses
0
Affichages
83
Réponses
2
Affichages
109