Colorisation de case sous certaines condition (Problème de synthaxe ?)

Vich

XLDnaute Nouveau
Salut tout le monde,

Je bloque su un problème depuis hier donc je viens demander un avis extérieur.

J'aimerais colorier des cases suivant des correspondance avec une base de données access.

Code:
'Application des pinces et positionneurs à utiliser
    Call LienAccess
    Dim NbContacts, J As Integer
    NbContacts = Range("A1").End(xlDown).Row
    Sheets("Rangement").Select
    For i = 2 To (NbCells * 2 + NbLigneSautee) 'Nombre de cellules à colorier, ou pas suivant la ref contacts
        Sheets("ACCESS Contacts").Select
        For J = 2 To NbContacts 'Liste les différents Contacts
            If Sheets("Rangement").Range("J" & i) = Sheets("ACCESS Contacts").Range("B" & J) Then 'Si refcontact = le contacts dans la base de données
                Sheets("Rangement").Range("K" & i) = Sheets("ACCESS Contacts").Range("H" & J) ' On rajoute 2 cellules qui n'ont rien a voir avec mon problème =)
                Sheets("Rangement").Range("L" & i) = Sheets("ACCESS Contacts").Range("I" & J)
                If Sheets("ACCESS Contacts").Range("M" & J) = "Non" Then 'Si la colonne M de la case actuellement selectionnée  alors on la colorie en orange + on force l'écriture en noir.
                    If Sheets("Rangement").Range("I" & i) <> "" Then 'Si la case n'est pas vide
                        Sheets("Rangement").Range("K" & i).Interior.ColorIndex = 46
                        Sheets("Rangement").Range("L" & i).Interior.ColorIndex = 46
                        Sheets("Rangement").Range("K" & i).Font.ColorIndex = 1
                        Sheets("Rangement").Range("L" & i).Font.ColorIndex = 1
                    End If
                End If
            End If
            If Sheets("Rangement").Range("K" & i) = "" And Sheets("Rangement").Range("L" & i) = "" Then 'Etant donné qu'il y a des lignes vides car on saute des lignes dans une autre méthode, si la ligne est qautée ( et donc vide) on ne la colore pas
                If Sheets("Rangement").Range("I" & i) <> "" Then ' L'erreur est ici, si la cellule est vide on la colorie en rouge.
                    Sheets("Rangement").Range("K" & i).Interior.ColorIndex = 3
                    Sheets("Rangement").Range("L" & i).Interior.ColorIndex = 3
                    Sheets("Rangement").Range("K" & i).Font.ColorIndex = 1
                    Sheets("Rangement").Range("L" & i).Font.ColorIndex = 1
                End If
            End If
        Next J
    Next i
    Sheets("ACCESS Contacts").Delete

Bref voilà en gros ... pour plus de détail je vous link un exemple de ce que je voudrais :

Regarde la pièce jointe Forum 1.xlsx

Merci d'avance,

Vich.
 

Pièces jointes

  • Forum 1.xlsx
    20.8 KB · Affichages: 55
  • Forum 1.xlsx
    20.8 KB · Affichages: 51

Vich

XLDnaute Nouveau
Re : Colorisation de case sous certaines condition (Problème de synthaxe ?)

Problème réglé après un gros brainstorming algo de ma part x) (A mon niveau du moins :p)

Code:
    Call LienAccess
    Sheets("Rangement").Select
    For i = 2 To (NbCells * 2 + NbLigneSautee)
        Sheets("ACCESS Contacts").Select
        For J = 2 To NbContacts
            If Sheets("ACCESS Contacts").Range("M" & J) = "Non" Then
                If Sheets("ACCESS Contacts").Range("B" & J) = Sheets("Rangement").Range("J" & i) Then
                    Sheets("Rangement").Range("K" & i).Interior.ColorIndex = 46
                    Sheets("Rangement").Range("L" & i).Interior.ColorIndex = 46
                    Sheets("Rangement").Range("K" & i).Font.ColorIndex = 1
                    Sheets("Rangement").Range("L" & i).Font.ColorIndex = 1
                End If
            End If
            If Sheets("ACCESS Contacts").Range("M" & J) <> "Non" And Sheets("ACCESS Contacts").Range("M" & J) <> "" Then
                If Sheets("ACCESS Contacts").Range("B" & J) = Sheets("Rangement").Range("J" & i) Then
                    Sheets("Rangement").Range("K" & i).Interior.ColorIndex = Sheets("Rangement").Range("E" & i).Interior.ColorIndex
                    Sheets("Rangement").Range("L" & i).Interior.ColorIndex = Sheets("Rangement").Range("E" & i).Interior.ColorIndex
                    Sheets("Rangement").Range("K" & i).Font.ColorIndex = Sheets("Rangement").Range("E" & i).Font.ColorIndex
                    Sheets("Rangement").Range("L" & i).Font.ColorIndex = Sheets("Rangement").Range("E" & i).Font.ColorIndex
                End If
            End If
            If Sheets("Rangement").Range("K" & i) = "" And Sheets("Rangement").Range("L" & i) = "" Then
                If Sheets("Rangement").Range("J" & i) <> "" Then
                    Sheets("Rangement").Range("K" & i).Interior.ColorIndex = 3
                    Sheets("Rangement").Range("L" & i).Interior.ColorIndex = 3
                End If
            End If
        Next J
    Next i
    Sheets("ACCESS Contacts").Delete
 

Discussions similaires

Réponses
4
Affichages
213

Statistiques des forums

Discussions
312 231
Messages
2 086 448
Membres
103 213
dernier inscrit
Poupoule