XL 2019 Double-clic en C2 ou "ok", colore de A2:I2, si C4, alors A4:I4 colorer de vert [résolu]

anthoYS

XLDnaute Barbatruc
Bonjour,

J'avais fait des topic déjà à ce sujet mais je ne sais plus comment faire...
=SI(C2="ok";....)
je m'y perds...
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 3 Then
Cells(Target.Row, 3) = Date
End If
End Sub
Rajouter un calendrier quand on clique sur date, voir USF présent dans le fichier...


Merci par avance,
je sais c'est basique mais je bloque...
 

Pièces jointes

  • Classeur_TEST.xlsm
    22.7 KB · Affichages: 13
Dernière édition:

anthoYS

XLDnaute Barbatruc
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("B1:N11")) Is Nothing Then
       Target.Interior.Color = IIf(Target.Interior.Color = vbGreen, xlNone, vbGreen)
    End If
End Sub
 

anthoYS

XLDnaute Barbatruc
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 3 Then
Cells(Target.Row, 1).Interior.ColorIndex = 4
Cells(Target.Row, 2).Interior.ColorIndex = 4
Cells(Target.Row, 3).Interior.ColorIndex = 4
Cells(Target.Row, 4).Interior.ColorIndex = 4
Cells(Target.Row, 5).Interior.ColorIndex = 4
Cells(Target.Row, 6).Interior.ColorIndex = 4
Cells(Target.Row, 7).Interior.ColorIndex = 4
Cells(Target.Row, 8).Interior.ColorIndex = 4
Cells(Target.Row, 9).Interior.ColorIndex = 4
End If
If Target.Column = 3 Then
Cells(Target.Row, 3) = "ok"
End If
Cancel = True
If Not Application.Intersect(Target, [J:J]) Is Nothing Then
Target.Value = IIf(Not Target.Value = "þ", "þ", "o")
    If Target.Value = "þ" Then
        Range(Target.Offset(0, -1), Target.Offset(0, -9)).Interior.ColorIndex = 15
            Else
        Range(Target.Offset(0, -1), Target.Offset(0, -9)).Interior.ColorIndex = xlNone
    End If
End If
If Not Application.Intersect(Target, [I:I]) Is Nothing Then
Target.Value = IIf(Not Target.Value = "þ", "þ", "o")
    If Target.Value = "þ" Then
        Range(Target.Offset(0, -1), Target.Offset(0, -9)).Interior.ColorIndex = 4
            Else
        Range(Target.Offset(0, -1), Target.Offset(0, -9)).Interior.ColorIndex = xlNone
    End If
End If
End Sub

???
je sais pas si l'est ok ce code VB (feuille).
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Peut être avec :
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("A1:N11")) Is Nothing Then
        If Target.Interior.Color = vbGreen Then
            Range("A" & Target.Row & ":I" & Target.Row).Interior.Color = vbWhite
            Cells(Target.Row, "C") = ""
        Else
            Range("A" & Target.Row & ":I" & Target.Row).Interior.Color = vbGreen
            Cells(Target.Row, "C") = "OK"
        End If
    End If
End Sub
 

Pièces jointes

  • Classeur_TEST (3).xlsm
    61 KB · Affichages: 4

anthoYS

XLDnaute Barbatruc
Peut être avec :
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("A1:N11")) Is Nothing Then
        If Target.Interior.Color = vbGreen Then
            Range("A" & Target.Row & ":I" & Target.Row).Interior.Color = vbWhite
            Cells(Target.Row, "C") = ""
        Else
            Range("A" & Target.Row & ":I" & Target.Row).Interior.Color = vbGreen
            Cells(Target.Row, "C") = "OK"
        End If
    End If
End Sub

Merci !
Comment faire aussi pour annuler la coloration en vert si on efface le "OK" ?
et retrouver la MEF d'avant, si c'est coloré de violet ça restera violet.
je sais pas si c'est clair. Par contre, si "ok" ça écrase évidemment le violet pour du vert toute la ligne enfin délimitée.
 

anthoYS

XLDnaute Barbatruc
VB:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True

     If (Target.Column = 4 Or Target.Column = 5) And Target.Columns.Count = 1 Then

         Select Case Target.Column
        
        Case 1: Target = Calendar.ShowX(Target(1), 2, 0, 0): ' region = 0 ou "US" Etats Unis

        Case 2: Target = Calendar.ShowX(Target(1), 2, 0, 1):   ' region = 1 ou "FR" France

        Case 3: Target = Calendar.ShowX(Target(1), 2, 0, 2): ' region = 2  ou "CA" Canada

        Case Else:  Target = Calendar.ShowX(Target(1), 0, 2):   'automatique region

        End Select
        
   'Unload Calendar
End Sub

bug première ligne jaune.

c'est bon j'ai inséré le "End If".
 

Discussions similaires