Discussion :

[dodo28]

Bonjour le forum,

pouvez vous m'aider pour ce probléme, et merci d'avance.
voila, j ai fait ce code qui me permet une recherche dans une base de donnée(BD) grace un userform. Il marche bien. mais voila je voudrais recuperer aussi la couleur du texte qui se trouve dans la BD.
voici le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Private Sub Valider_Click()
 
Dim X As Integer, Y As Integer, NLBD As Integer, NLVisio As Integer
 
   Application.Cursor = xlWait
Application.ScreenUpdating = False
 
'suppresson de la selection
Sheets("visio").Range("A2:J64000").EntireRow.Clear
 
With Sheets("BD")
 
    NLBD = .Range("a" & .Rows.Count).End(xlUp).Row
    .Range("A:A").NumberFormat = "@"
 
    If RechercheparCommune <> "" Then
           Y = 2
        For X = 2 To NLBD
            If .Range("D" & X).Value = RechercheparCommune Then
            Sheets("visio").Range("A" & Y).EntireRow.Value = .Range("a" & X).EntireRow.Value
           Y = Y + 1
            End If
        Next X
    End If
 
   If RechercheparNom <> "" Then
   Y = 2
        For X = 2 To NLBD
        If .Range("c" & X).Value = RechercheparNom Then
        Sheets("visio").Range("a" & Y).EntireRow.Value = .Range("a" & X).EntireRow.Value
   Y = Y + 1
         End If
        Next X
   End If
 
   If RechercheParMatricule <> "" Then
   Y = 2
    For X = 2 To NLBD
        If .Range("a" & X).Value = RechercheParMatricule Then
           Sheets("visio").Range("a" & Y).EntireRow.Value = .Range("a" & X).EntireRow.Value
        Y = Y + 1
        End If
    Next X
   End If
 
End With
   Application.Cursor = xlDefault
   Application.ScreenUpdating = True
 
Unload Me
End Sub

merci pour votre aide

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range(Destination).Font.Color=Range(Source).Font.Color

[dodo28]

desolé j ai fait ca mais ca ne marche pas,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
If RechercheparCommune <> "" Then
           Y = 2
        For X = 2 To NLBD
            If .Range("D" & X).Value = RechercheparCommune Then
            Sheets("visio").Range("A" & Y).EntireRow.Font.Color = .Range("a" & X).EntireRow.Font.Color
           Y = Y + 1
            End If
        Next X
    End If

merci pour ton aide

[mercatog]

Cellule par cellule!!!!!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For i = 1 To 255
    Sheets("Visio").Cells(Y, i).Font.Color = .Cells(X, i).Font.Color
Next i

Edit: pour ton cas!

ReEdit: Si toute ta "EntireRow" a une unique couleur (même les cellules vides), alors ça aussi fonctionne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Visio").Range("A" & Y).EntireRow.Font.Color = .Range("A" & X).Font.Color

[dodo28]

hé non, il y a des textes en 5 couleurs differentes.
merci pour ton aide

j ai essayé ta methode mais ca ne marche pas j ai bien du mal!
Ca ne bug pas, mais rien ne s affiche

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
If RechercheparCommune <> "" Then
           Y = 2
        For X = 2 To NLBD
            If .Range("D" & X).Value = RechercheparCommune Then
            For i = 1 To 255
    Sheets("Visio").Cells(Y, i).Font.Color = .Cells(X, i).Font.Color
            Next i
 
           Y = Y + 1
            End If
        Next X
    End If

[mercatog]

Mais tu ne copies pas les données!!!! Il faut copier les valeurs, ensuite les couleurs

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
If RechercheparCommune <> "" Then
    Y = 2
    For X = 2 To NLBD
        If .Range("D" & X).Value = RechercheparCommune Then
            Sheets("visio").Range("A" & Y).EntireRow.Value = .Range("a" & X).EntireRow.Value
            For i = 1 To 255
                Sheets("Visio").Cells(Y, i).Font.Color = .Cells(X, i).Font.Color
            Next i
            Y = Y + 1
        End If
    Next X
End If

Au lieu de 255, se contenter de la zone de données

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
If RechercheparCommune <> "" Then
    Y = 2
    For X = 2 To NLBD
        If .Range("D" & X).Value = RechercheparCommune Then
            Sheets("visio").Range("A" & Y).EntireRow.Value = .Range("a" & X).EntireRow.Value
            For i = 1 To .Range("IV" & X).End(xlToRight).Column
                Sheets("Visio").Cells(Y, i).Font.Color = .Cells(X, i).Font.Color
            Next i
            Y = Y + 1
        End If
    Next X
End If