Discussion :

[delphine1987]

Bonjour à tous,

J'ai cherché sur le forum mais je n'ai pas trouvé de réponses à ma question.
Je souhaite importer des données d'un fichier excel vers un autre sous certaines conditions. Un de ces conditions est la couleur de la police (rouge) mais je ne c'est pas comment le faire à partir de mon code.

Cette information est contenue dans la colonne 24 (fichier Activities status)

Merci d'avance pour votre aide

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
Sub reporter_std() 
Dim Sh As Worksheet 
 
Dim LastLig As Long, NewLig As Long 
Dim c As Range 
Dim Valeur As String 
 
 
Valeur = InputBox("Entrée période", "Choix de la période") 
If Valeur <> "" Then 
Application.ScreenUpdating = False 
With Workbooks("2010 STD Activities status.xls").Sheets("2010") 
   .AutoFilterMode = False 
   LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row 
   With .Range("A4:X" & LastLig) 
      .AutoFilter field:=17, Criteria1:=Valeur 
      .AutoFilter field:=24, Criteria1:=">0" 
      .AutoFilter field:=9, Criteria1:="STD" 
     End With 
   If .Range("A4:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then 
      Set Sh = Worksheets("std") 
      NewLig = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row + 1 
      For Each c In .Range("A5:A" & LastLig).SpecialCells(xlCellTypeVisible) 
         Sh.Cells(NewLig, 1).Value = .Cells(c.Row, 7).Value 
         Sh.Cells(NewLig, 2).Value = .Cells(c.Row, 8).Value 
         Sh.Cells(NewLig, 5).Value = .Cells(c.Row, 10).Value 
         Sh.Cells(NewLig, 7).Value = .Cells(c.Row, 12).Value 
         Sh.Cells(NewLig, 16).Value = .Cells(c.Row, 17).Value 
         Sh.Cells(NewLig, 12).Value = .Cells(c.Row, 24).Value 
         Sh.Cells(NewLig, 8).Value = .Cells(c.Row, 9).Value 
         Sh.Cells(NewLig, 9).Value = .Cells(c.Row, 29).Value 
         Sh.Cells(NewLig, 3).Value = UCase(Sh.Cells(NewLig, 1).Value) & UCase(Sh.Cells(NewLig, 2).Value) 
         Sh.Cells(NewLig, 3).Value = Replace(Cells(NewLig, 3).Value, " ", "") 
         NewLig = NewLig + 1 
 
 
      Next c 
      Set Sh = Nothing 
      .AutoFilterMode = False 
   End If 
End With 
End If 
End Sub

Delphine

[EvaristeGaloisBis]

salut,

Je n'ai pas lu tout ton code, mais pour faire un teste sur la couleur de la police le code a mettre est :

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
'
' Tu mets cette fonction dans ton module
Public Function IsRedFont(rgData As Range) As Boolean
  IsRedFont = rgData.Font.Color = ColorConstants.vbRed
End Function
 
 
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'la ligne de code que tu dois rajouter
'
'
if IsRedFont(.Cells(c.Row, 7).Value ) then
  'Ce que tu dois faire
end if