[RÉSOLU] InteriorColor et ColorIndex

un internaute

XLDnaute Impliqué
Bonjour le forum
Dans le fichier joint je n'arrive pas à faire

1 Double Click = Oui = couleur de fond et couleur police
2 Double Click = Non = couleur de fond différente et couleur police différente
3 Double Click Retour à la couleur de fond sans écriture (couleur 15)
Merci à vous
 
Dernière édition:

un internaute

XLDnaute Impliqué
Bonjour le forum
Dans le fichier joint qui fonctionne bien
Pourrait-on faire ceci
1er Double clic oui
2ème Double Clic Non
Je voudrais revenir au 3ème Double Clic à la couleur 36 (jaune) sans aucune écriture
Merci à vous
Bonne fêtes
 

Pièces jointes

  • toto.xls
    63 KB · Affichages: 13

David Aubert

XLDnaute Barbatruc
Administrateur
Modérateur
Bonjour,
Comme signalé par Bruno, il n'est pas bien vu de double poster sur des forums différents.
Pour faire simple, quand tu agis ainsi il y a plusieurs personnes qui "bossent" pour toi et qui le font pour rien.
Merci d'être attentif à cela et à privilégier un forum plutôt qu'un autre et tant qu'à faire, privilégie celui-ci ;):D
Bonne journée
David
 

un internaute

XLDnaute Impliqué
Voilà la macro et ça fonctionne
Bonne fin de soirée à tous


Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

  If Target.Address = "$A$2" And Target.Count = 1 Then
    AfficherMasquerPeriodicite
    Range("A1").Select
    Exit Sub
  End If

    Init  'Module posologie
If Target.Column = 1 Then Target.Value = Date: Cancel = True
  If Not Intersect(Range("C3:C" & Range("A" & Rows.Count).End(xlUp).Row), Target) Is Nothing Then
    Cancel = True
    If Range("A" & Target.Row) = "" Then
      MsgBox "Double Click Cellule A3 pour Afficher la date"
      Exit Sub
    End If

    Target = IIf(Target = "toto", "", "toto")
  ElseIf Not Intersect(Range("B3:B" & Range("A" & Rows.Count).End(xlUp).Row), Target) Is Nothing Then
    Cancel = True
    Target = IIf(Target = NbAmpoule, "", NbAmpoule)
    
  End If
    If Target.Column = 9 And Target.Row >= 2 And Target.Row <= 106 Then
Application.EnableEvents = False
        With ActiveCell.Offset(0, -8).Resize(1, 8)
            
            If ActiveCell = "Non" Then
              ActiveCell = ""
            ElseIf ActiveCell = "" Then
               ActiveCell = "Oui"
              .Font.Strikethrough = True
            Else
               ActiveCell = "Non"
              .Font.Strikethrough = False
            End If
            
        End With

        With ActiveCell
            If .Offset(0, -8) <> "" And .Offset(0, -8).Font.Strikethrough = True Then
                .Interior.ColorIndex = 35
                .Font.ColorIndex = 5
            Else
              If ActiveCell = "" Then
                .Interior.ColorIndex = 36
              Else
                .Interior.ColorIndex = 40
                .Font.ColorIndex = 5
              End If
            End If
        End With
    End If
Cancel = True
Application.EnableEvents = True
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 010
Membres
101 866
dernier inscrit
XFPRO