Déterminer la couleur de la cellule de la col

Fermé
Signaler
-
 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

4 réponses

Messages postés
1661
Date d'inscription
mardi 27 mai 2008
Statut
Membre
Dernière intervention
27 juillet 2012
612
Il te manque pas des "Else" ???
0
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
Messages postés
1661
Date d'inscription
mardi 27 mai 2008
Statut
Membre
Dernière intervention
27 juillet 2012
612
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
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
> Jeanne
Revoici 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
Messages postés
1661
Date d'inscription
mardi 27 mai 2008
Statut
Membre
Dernière intervention
27 juillet 2012
612 > Jeanne
c'est en quel langage?
0
>
Messages postés
1661
Date d'inscription
mardi 27 mai 2008
Statut
Membre
Dernière intervention
27 juillet 2012

C'est en VBA

Jeanne
0
Messages postés
1661
Date d'inscription
mardi 27 mai 2008
Statut
Membre
Dernière intervention
27 juillet 2012
612
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
Pas grave. Merci quand même !
Bonne journée !

Jeanne
0
Messages postés
6917
Date d'inscription
mardi 25 septembre 2007
Statut
Membre
Dernière intervention
1 novembre 2016
1 190 > Jeanne
Bonjour,

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
>
Messages postés
6917
Date d'inscription
mardi 25 septembre 2007
Statut
Membre
Dernière intervention
1 novembre 2016

Merci bcp : là je finis un fichier et je le teste en début d'après midi.
Jeanne
0
Messages postés
433
Date d'inscription
dimanche 17 février 2008
Statut
Membre
Dernière intervention
17 octobre 2008
309
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
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
Messages postés
6917
Date d'inscription
mardi 25 septembre 2007
Statut
Membre
Dernière intervention
1 novembre 2016
1 190 > Jeanne
lol
bienvenue au club

;o)
0
>
Messages postés
6917
Date d'inscription
mardi 25 septembre 2007
Statut
Membre
Dernière intervention
1 novembre 2016

ç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