IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

impression couleur d'une cellule en fonction de la couleur d'une autre cellule [XL-2003]


Sujet :

Macros et VBA Excel

  1. #41
    Expert éminent sénior
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Points : 14 363
    Points
    14 363
    Par défaut
    Bonjour,

    Ce bug est il du aux annotations sur les celles A46 à A50 ??
    Oui, en partie, et à la modif du code que tu as apportée pour y remédier. Il fallait mettre :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    For Each C In .Range(.[A13], .Cells(13, 1).End(xlDown))
    au lieu de :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    For Each C In .Range(.[A13], .Cells(.Rows.Count, 1).End(xlDown))
    - les lignes A45 et A46 se colorent en rouge.
    Ben oui, c'est joli, aussi
    Bon, sérieux, la macro est maintenant :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    Sub couleur()
     
     
        Dim C As Range
        With ActiveSheet
            .[A13:Q43].Interior.ColorIndex = xlNone
            For Each C In .Range(.[A13], .Cells(13, 1).End(xlDown))
                If Application.Weekday(C.Value) = 4 Then
                    C.Resize(, 17).Interior.ColorIndex = 15
                    Intersect(C.EntireRow, Union(.[D:E], .[G:H], .[J:K], .[M:O])).Value = #12:00:00 AM#
                    Intersect(C.EntireRow, .[P:Q]).Value = ""
                ElseIf Application.Weekday(C.Value, 2) > 5 Then
                    C.Resize(, 17).Interior.ColorIndex = 3
                    Intersect(C.EntireRow, Union(.[D:E], .[G:H], .[J:K], .[M:O])).Value = #12:00:00 AM#
                    Intersect(C.EntireRow, .[P:Q]).Value = ""
                End If
            Next C
            .[P:Q].NumberFormat = "hh:mm"
        End With
     
    End Sub

  2. #42
    Membre actif
    Inscrit en
    Avril 2007
    Messages
    1 241
    Détails du profil
    Informations forums :
    Inscription : Avril 2007
    Messages : 1 241
    Points : 213
    Points
    213
    Par défaut
    que dire de plus daniel ...
    Merci pour tout et je te souhaite un excellent week end..
    Au fait.. est ce que tu es aussi à l'aise avec vba access...

  3. #43
    Expert éminent sénior
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Points : 14 363
    Points
    14 363
    Par défaut
    Au fait.. est ce que tu es aussi à l'aise avec vba access...
    Non, pas du tout; comme le disait ma grand-mère : "bon à tout, propre à rien !".

  4. #44
    Membre actif
    Inscrit en
    Avril 2007
    Messages
    1 241
    Détails du profil
    Informations forums :
    Inscription : Avril 2007
    Messages : 1 241
    Points : 213
    Points
    213
    Par défaut
    zut.....non je rigole..
    Daniel , il n'empeche que sur vba excel , tu es au top..
    bon week end à toi et a plus on ne sais jamais...

  5. #45
    Membre régulier
    Profil pro
    Inscrit en
    Août 2009
    Messages
    55
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2009
    Messages : 55
    Points : 75
    Points
    75
    Par défaut
    Bonjour
    je te propose cette solution
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    Sub ligne_couleur()
     Dim montexte As String
     Dim monjour As String
    Dim rcel As Range
    Range("A13").Select
     Selection.CurrentRegion.Select
     
     For Each rcel In Selection
        montexte = rcel.Text
        malongeurTexte = Len(rcel.Text)
        monjour = Left(montexte, malongeurTexte - 8)
            If monjour = "mercredi" Then
               rcel.Interior.ColorIndex = 48
            End If
             If monjour = "samedi" Or monjour = "dimanche" Then
               rcel.Interior.ColorIndex = 36
            End If
     Next rcel
     
     
    End Sub
    si tu souhaites colorier la ligne entière comme tu le demandais
    tu replaces
    rcel.Interior.ColorIndex
    par
    rcel.EntireRow.Interior.ColorIndex
    Cordialement

  6. #46
    Membre actif
    Inscrit en
    Avril 2007
    Messages
    1 241
    Détails du profil
    Informations forums :
    Inscription : Avril 2007
    Messages : 1 241
    Points : 213
    Points
    213
    Par défaut
    merci evx136 mais la macro de daniel.C me convient.
    Je garde néanmoins ta macro de coté en cas ou..

  7. #47
    Membre régulier
    Profil pro
    Inscrit en
    Août 2009
    Messages
    55
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2009
    Messages : 55
    Points : 75
    Points
    75
    Par défaut
    Bonjour

    Voici ce que je te propose
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    Sub ligne_couleur()
     Dim montexte As String
     Dim monjour As String
    Dim rcel As Range
    Range("A13").Select
     Selection.CurrentRegion.Select
     
     For Each rcel In Selection
        montexte = rcel.Text
        malongeurTexte = Len(rcel.Text)
        monjour = Left(montexte, malongeurTexte - 8)
            If monjour = "mercredi" Then
               rcel.Interior.ColorIndex = 48
               ' si tu veux la ligne entière : rcel.EntireRow.Interior.ColorIndex = 48
     
            End If
             If monjour = "samedi" Or monjour = "dimanche" Then
               rcel.Interior.ColorIndex = 36
               ' si tu veux la ligne entière : rcel.EntireRow.Interior.ColorIndex = 36
            End If
     Next rcel
     
     
    End Sub
    Cordialement

  8. #48
    Membre régulier
    Profil pro
    Inscrit en
    Août 2009
    Messages
    55
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2009
    Messages : 55
    Points : 75
    Points
    75
    Par défaut
    Excuse moi je n'avais pas tout lu les messages.
    Je crois que mon Internet beugue un peu.
    Bon courage.

+ Répondre à la discussion
Cette discussion est résolue.
Page 3 sur 3 PremièrePremière 123

Discussions similaires

  1. [XL-2010] Effacer des cellules en fonction de la valeur d'un autre cellule
    Par aalex85 dans le forum Excel
    Réponses: 9
    Dernier message: 02/02/2015, 09h42
  2. Réponses: 6
    Dernier message: 28/01/2015, 22h31
  3. Réponses: 12
    Dernier message: 30/12/2010, 15h30
  4. Réponses: 5
    Dernier message: 03/02/2009, 14h43
  5. Réponses: 4
    Dernier message: 20/03/2007, 19h50

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo