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.