Déterminer la couleur de la cellule de la col

Jeanne -  
Bonjour,

Je souhaite déterminer la couleur de la cellule de la colonne C et selon celle-ci y insérer un message.

Mon code ne présente paw de messages d'erreur mais ne me communique aucun résultat.

Et je ne comprend pas pourquoi !

QQ un peut-il m'aider ?

D'avance merci.

Jeanne
Sub allocation_type_contrats()

Dim NbreLignes As Integer
Dim Ligne As Integer
Dim Nom_Onglet As String

'récupération de l'onglet
Nom_Onglet = "LISTE FOURNISSEURS 31 08 07"
Sheets(Nom_Onglet).Select

'Boucle qui détermine la couleur de l'onglet et selon celui-ci, insère un ctaire dans la cellule

NbreLignes = ActiveSheet.Range("C1").CurrentRegion.Rows.Count

For Ligne = 1 To NbreLignes
If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 6 Then
ActiveSheet.Cells("C" & Ligne) = "CONTRAT OK"
If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 20 Then
ActiveSheet.Cells("C" & Ligne) = "FOURNISSEUR PONCTUEL"
If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 3 Then
ActiveSheet.Cells("C" & Ligne) = "NON PRESTATAIRE"
If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 7 Then
ActiveSheet.Cells("C" & Ligne) = "DOC A COMPLETER"

End If
End If
End If
End If

Next

End Sub
Configuration: Windows XP
Internet Explorer 6.0

4 réponses

  1.  Remad
    Il te manque pas des "Else" ???
    0
    1. Jeanne
      Euh si sûrement....
      > Donc j'ai modifié en conséquence ma boucle mais je n'ai toujours pas de
      > résultat qui s'affiche dans la cellule concernée !!!!
      0
  2. Remad
    Et comme sa ?

    If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 6
    Then ActiveSheet.Cells("C" & Ligne) = "CONTRAT OK"
    Else
    {
    If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 20
    Then ActiveSheet.Cells("C" & Ligne) = "FOURNISSEUR PONCTUEL"
    Else
    {
    If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 3
    Then ActiveSheet.Cells("C" & Ligne) = "NON PRESTATAIRE"
    Else
    {
    If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 7
    Then ActiveSheet.Cells("C" & Ligne) = "DOC A COMPLETER"
    End If
    }End If
    }End If
    }End If
    0
    1. Jeanne
      Hélas j'ai une erreur de syntaxe qui dit :Erreur de compilation Erreur de syntaxe sur le premier If
      Je suis un peu perdue....

      Sub allocation_type_contrats()

      Dim NbreLignes As Integer
      Dim Ligne As Integer
      Dim Nom_Onglet As String

      'récupération de l'onglet
      Nom_Onglet = "LISTE FOURNISSEURS 31 08 07"
      Sheets(Nom_Onglet).Select

      'Boucle qui détermine la couleur de l'onglet et selon celui-ci, insère un ctaire dans la cellule

      NbreLignes = ActiveSheet.Range("C1").CurrentRegion.Rows.Count

      For Ligne = 1 To NbreLignes

      If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 6
      Then ActiveSheet.Cells("C" & Ligne) = "CONTRAT OK"
      Else

      If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 20
      ActiveSheet.Cells("C" & Ligne) = "FOURNISSEUR PONCTUEL"
      Else

      If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 3
      Then ActiveSheet.Cells("C" & Ligne) = "NON PRESTATAIRE"
      Else

      If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 7
      Then ActiveSheet.Cells("C" & Ligne) = "DOC A COMPLETER"
      End If
      End If
      End If
      End If

      End Sub
      0
    2. Jeanne
      @JeanneRevoici mon code, toujours sans résultat....

      Sub allocation_type_contrats()

      Dim NbreLignes As Integer
      Dim Ligne As Integer
      Dim Nom_Onglet As String

      'récupération de l'onglet
      Nom_Onglet = "LISTE FOURNISSEURS 31 08 07"
      Sheets(Nom_Onglet).Select

      'Boucle qui détermine la couleur de l'onglet et selon celui-ci, insère un ctaire dans la cellule

      NbreLignes = ActiveSheet.Range("C1").CurrentRegion.Rows.Count

      For Ligne = 1 To NbreLignes

      If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 6 Then
      ActiveSheet.Cells("C" & Ligne) = "CONTRAT OK"
      Else

      If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 20 Then
      ActiveSheet.Cells("C" & Ligne) = "FOURNISSEUR PONCTUEL"
      Else

      If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 3 Then
      ActiveSheet.Cells("C" & Ligne) = "NON PRESTATAIRE"
      Else

      If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 7 Then
      ActiveSheet.Cells("C" & Ligne) = "DOC A COMPLETER"
      End If
      End If
      End If
      End If

      Next

      End Sub
      0
    3. Remad
      @Jeannec'est en quel langage?
      0
    4. Jeanne
      @RemadC'est en VBA

      Jeanne
      0
  3. Remad
    Essaye de voir si il manque pas des "if" des "then" ou des "else" comme ici : http://www.commentcamarche.net/forum/affich 3081463 vba fonction if need help je ne connais pas plus le VBA. Désolé.
    0
    1. Jeanne
      Pas grave. Merci quand même !
      Bonne journée !

      Jeanne
      0
    2. Polux31
      @JeanneBonjour,

      Essaies ça : 
      Sub allocation_type_contrats()

Dim NbreLignes As Integer
Dim Ligne As Integer
Dim ws As Worksheet
'
    Set ws = Worksheets("LISTE FOURNISSEURS 31 08 07")
    
    With ws
        NbreLignes = .Range("C1").CurrentRegion.Rows.Count
        For Ligne = 1 To NbreLignes

            If .Range("C" & Ligne).Interior.ColorIndex = 6 Then
                .Range("C" & Ligne).Value = "CONTRAT OK"
            End If
            
            If .Range("C" & Ligne).Interior.ColorIndex = 8 Then
                .Range("C" & Ligne).Value = "FOURNISSEUR PONCTUEL"
            End If
            
            If .Range("C" & Ligne).Interior.ColorIndex = 3 Then
                .Range("C" & Ligne).Value = "NON PRESTATAIRE"
            End If
            
            If .Range("C" & Ligne).Interior.ColorIndex = 7 Then
               .Range("C" & Ligne).Value = "DOC A COMPLETER"
            End If
        Next
        
    End With

End Sub


      Bon courage

      ;o)

      polux
      0
    3. Jeanne
      @Polux31Merci bcp : là je finis un fichier et je le teste en début d'après midi.
      Jeanne
      0
  4. Ivan-hoe
    Salut Jeanne,
    tu emploies mal les If... ElseIf...EndIf. Du coup, seule la première condition est testée.
    (de plus, attention, tu emploies Cells incorrectement, remplace par Range) 
    If ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 6 Then
    ActiveSheet.Range("C" & Ligne) = "CONTRAT OK"
ElseIf ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 20 Then
    ActiveSheet.Range("C" & Ligne) = "FOURNISSEUR PONCTUEL"
ElseIf ActiveSheet.Range("C" & Ligne).Interior.ColorIndex = 3 Then
    ActiveSheet.Range("C" & Ligne) = "NON PRESTATAIRE"
End If

    Autre manière, plus claire : 
    For ligne = 1 To NbreLignes
    With ActiveSheet.Range("C" & ligne)
        Select Case .Interior.ColorIndex
            Case Is = 6
                .Value = "CONTRAT OK"
            Case Is = 20
                .Value = "FOURNISSEUR PONCTUEL"
            Case Is = 3
                .Value = "NON PRESTATAIRE"
        End Select
    End With
Next ligne

    A suivre...
    0
    1. Jeanne
      Merci encore pour toutes ces réponses !
      Je teste le code dès que j'ai terminé ce sur quoi je travaille.
      Ah, quelle belle communauté que celle des VBAistes...;
      Jeanne
      0
    2. Polux31
      @Jeannelol
      bienvenue au club

      ;o)
      0
    3. Jeanne
      @Polux31ça y est : j'ai eu la solution d'une programmeuse patentée, future contrôleuse de gestion (elle est trop forte cette Sandrine !!!)

      Je vous la communique et remercie tous ceux qui ont contribué à l'élaboration de ce code.

      Sub allocation_type_contrats1()
      >
      >
      >
      > Dim NbreLignes As Integer
      > Dim Ligne As Integer
      >
      > 'on part de la dernière ligne excel, et on remonte jusqu'à trouver une cellule ou quelque chose est écrit... ce sera ta dernière ligne
      > NbreLignes = ActiveSheet.Range("B65536").End(xlUp).Row
      >
      > 'cela veut dire que si VB trouve une erreur, il passera à la ligne suivante
      > 'je suis obligée de mettre ca (qui n'est pas génial)
      > 'car la ligne .addcomment bloque si la cellule a déjà un commentaire
      > On Error Resume Next
      >
      > 'boucle de la ligne 1 à la dernière
      > For Ligne = 1 To NbreLignes
      > 'selon la couleur de la cellule
      > Select Case ActiveSheet.Range("C" & Ligne).Interior.ColorIndex
      > 'si c'est jaune
      > Case 6
      > 'je rajoute un commentaire à la cellule
      > Range("D" & Ligne).AddComment
      > 'saisie du texte du commentaire
      > Range("D" & Ligne).Comment.Text Text:="CONTRAT OK"
      > Case 20
      > Range("D" & Ligne).AddComment
      > Range("D" & Ligne).Comment.Text Text:="FOURNISSEUR PONCTUEL"
      > Case 3
      > Range("D" & Ligne).AddComment
      > Range("D" & Ligne).Comment.Text Text:="NON PRESTATAIRE"
      > End Select
      > Next Ligne
      >
      > End Sub
      >
      0

Discussions similaires

Code source couleur de fond
Mehdi-Amg

9 réponses
Retrouver réglages couleurs d'origine de mon écran W10
LoulouSophie

8 réponses
couleur personnage
Gasper

9 réponses
Changer Couleur Pseudo SnatChat
paulo.1

9 réponses
Bitmoji
Manon

1 réponse