Sujet Précédent Sujet Suivant

Déterminer la couleur de la cellule de la col

Jeanne -  
 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
A voir également:

4 réponses

Réponse 1 / 4
Remad Messages postés 1694 Statut Membre 716
 
Il te manque pas des "Else" ???
0
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
Réponse 2 / 4
Remad Messages postés 1694 Statut Membre 716
 
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
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
Jeanne > 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
Remad Messages postés 1694 Statut Membre 716 > Jeanne
 
c'est en quel langage?
0
Jeanne > Remad Messages postés 1694 Statut Membre
 
C'est en VBA

Jeanne
0
Réponse 3 / 4
Remad Messages postés 1694 Statut Membre 716
 
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
Jeanne
 
Pas grave. Merci quand même !
Bonne journée !

Jeanne
0
Polux31 Messages postés 7219 Statut Membre 1 204 > 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
Jeanne > Polux31 Messages postés 7219 Statut Membre
 
Merci bcp : là je finis un fichier et je le teste en début d'après midi.
Jeanne
0
Réponse 4 / 4
Ivan-hoe Messages postés 433 Date d'inscription   Statut Membre Dernière intervention   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
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
Polux31 Messages postés 7219 Statut Membre 1 204 > Jeanne
 
lol
bienvenue au club

;o)
0
Jeanne > Polux31 Messages postés 7219 Statut Membre
 
ç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 -
Techno01 -

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

8 réponses
couleur personnage
Gasper -
Izzi -

9 réponses
Bitmoji
Manon -
Radinoz -

1 réponse
Changer Couleur Pseudo SnatChat
paulo.1 -
Tkt -

9 réponses