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

anthoYS · 2 Décembre 2020

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

sylvanu · 2 Décembre 2020

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

VB:

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

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

sylvanu · 2 Décembre 2020

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

anthoYS · 2 Décembre 2020

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

anthoYS · 2 Décembre 2020

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

sylvanu · 2 Décembre 2020

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

anthoYS · 2 Décembre 2020

sylvanu à dit:
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 · 2 Décembre 2020

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 · 2 Décembre 2020

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

anthoYS · 2 Décembre 2020

sylvanu à dit:
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 · 2 Décembre 2020

sylvanu à dit:

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.

sylvanu · 2 Décembre 2020

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

VB:

 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 · 2 Décembre 2020

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

VB:

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 · 2 Décembre 2020

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

anthoYS · 2 Décembre 2020

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

anthoYS · 2 Décembre 2020

sylvanu à dit:
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.

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

Pièces jointes

sylvanu

sylvanu

XLDnaute Barbatruc

Pièces jointes

anthoYS

XLDnaute Barbatruc

anthoYS

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Pièces jointes

anthoYS

XLDnaute Barbatruc

anthoYS

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Pièces jointes

anthoYS

XLDnaute Barbatruc

anthoYS

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Pièces jointes

anthoYS

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

anthoYS

XLDnaute Barbatruc

anthoYS

XLDnaute Barbatruc

Discussions similaires