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.
	
	
	
	
	
		
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.
	
		
			
		
		
	
				
			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.