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

[anthoYS]

Bonjour,

J'avais fait des topic déjà à ce sujet mais je ne sais plus comment faire...
=SI(C2="ok";....)
je m'y perds...

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

 

[sylvanu]

Bonjour Antho,
En PJ un essai du célèbre calendar de PatrickToulon de XLD. A voir si cela vous va.

 

[anthoYS]

Merci par contre pour la ligne colorée en verte, je ne sais pas quoi faire...
je vais chercher un peu.

 

[anthoYS]

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

 

[sylvanu]

Avec une MFC qui met vert si OK en colonne C.

 

[anthoYS]

Avec une MFC qui met vert si OK en colonne C.

Merci comment faire pour qu'un double clic dans la cellule mette "ok" dans la cellule ?
je ne veux pas de menu déroulant, c'est plus long je trouve, je préfère un double clic dans la cellule. C'est plus simple pour moi.

je vais chercher ...


Merci encore !

 

[anthoYS]

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]

Peut être avec :

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

 

[anthoYS]

Bonjour Antho,
En PJ un essai du célèbre calendar de PatrickToulon de XLD. A voir si cela vous va.

Comment ouvrir également le calendrier en cellule voisine (C&D) ?

 

[anthoYS]

Peut être avec :

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.

 

[sylvanu]

C'est plutôt en colonne D et E ? où il y a des dates;
La modif est à la ligne :

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

A vous de l'adapter en fonction de vos besoins.

 

[anthoYS]

C'est plutôt en colonne D et E ? où il y a des dates;
La modif est à la ligne :

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

A vous de l'adapter en fonction de vos besoins.

oui D ou E exact, c'est juste que j'ai suivi ta première réponse.
Mais j'aurais adapté, merci de la correction et de l'amélioration du code.

 

[sylvanu]

Désolé une mise en couleur n'effacera pas une MFC, sauf à la supprimer. La couleur MFC sera toujours prépondérante.

 

[anthoYS]

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

 

[anthoYS]

Désolé une mise en couleur n'effacera pas une MFC, sauf à la supprimer. La couleur MFC sera toujours prépondérante.

Ok je ne savais pas, merci beaucoup.
Donc c'est ok là, je crois que j'ai pour cet onglet tout ce que je voulais.