Probleme mise en forme dans ma macro

[gigiwin]

Bonjour,

J’ai un classeur Excel (voir ci-joint).

Dans la feuille « STAT H FACT. », je voudrais que les noms soient en GRAS ROUGE si la cellule F de la même ligne est supérieure à ZERO.

J’ai cela dans ma macro, et j’ai aussi une mise en forme conditionnelle sur la colonne A, mais cela ne fonctionne pas toujours.

Et, serait-il possible de faire que les cellules soient avec une bordure comme les autres colonnes.

Merci de votre aide.
Cordialement

GIGIWIN

 

[PMO2]

Re : Probleme mise en forme dans ma macro

Bonjour,

Essayez le code modifié

Sub RecapFact()
    Dim sh As Variant, fin&, i&, Mondico As Object
    Application.ScreenUpdating = 0
    Set Mondico = CreateObject("Scripting.Dictionary")
    For Each sh In Array(Feuil1, Feuil2, Feuil3, Feuil4)
        If sh.Name <> "Feuil5" Then
            fin = sh.Range("D" & Rows.Count).End(xlUp).Row
            For i = 2 To fin
                If sh.Cells(i, 5) > 0 Then
                    If Not Mondico.exists(sh.Cells(i, 4).Value) Then Mondico.Add sh.Cells(i, 4).Value, sh.Cells(i, 4).Value
                End If
            Next i
        End If
    Next sh
    With Feuil5
        .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).Clear
        .Range("A2").Resize(Mondico.Count, 1) = Application.Transpose(Mondico.items)
        .Range("A2:A" & .Range("A65000").End(xlUp).Row).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo
        fin = .Range("A65000").End(xlUp).Row
        For i = 2 To fin
            If .Cells(i, 6) > 0 Then .Cells(i, 1).Font.ColorIndex = 3 '///modif
            If .Cells(i, 6) > 0 Then .Cells(i, 1).Font.Bold = True    '///modif
        Next i
    End With
End Sub

 

[gigiwin]

Re : Probleme mise en forme dans ma macro

Re,

Merci pour votre réponse;

Cela fonctionne pour le format police mais les bordures ne se mettent pas.

Pourriez-vous me dire à quoi correspond: " '///modif " que vous avez rajouté.

GIGIWIN

 

[PMO2]

Re : Probleme mise en forme dans ma macro

Essayez ce nouveau code

Sub RecapFact()
    Dim sh As Variant, fin&, i&, Mondico As Object
    Application.ScreenUpdating = 0
    Set Mondico = CreateObject("Scripting.Dictionary")
    For Each sh In Array(Feuil1, Feuil2, Feuil3, Feuil4)
        If sh.Name <> "Feuil5" Then
            fin = sh.Range("D" & Rows.Count).End(xlUp).Row
            For i = 2 To fin
                If sh.Cells(i, 5) > 0 Then
                    If Not Mondico.exists(sh.Cells(i, 4).Value) Then Mondico.Add sh.Cells(i, 4).Value, sh.Cells(i, 4).Value
                End If
            Next i
        End If
    Next sh
    With Feuil5
        .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).Clear
        .Range("A2").Resize(Mondico.Count, 1) = Application.Transpose(Mondico.items)
        .Range("A2:A" & .Range("A65000").End(xlUp).Row).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo
        fin = .Range("A65000").End(xlUp).Row
        For i = 2 To fin
            If .Cells(i, 6) > 0 Then
              With .Cells(i, 1).Font
                .ColorIndex = 3
                .Bold = True
              End With
            End If
        Next i
        
      Dim R As Range
      Set R = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
      On Error Resume Next
      For i = 7 To 12
          With R.Borders(i)
              .LineStyle = xlContinuous
              .Weight = xlThin
              .ColorIndex = xlAutomatic
          End With
      Next i
      On Error GoTo 0
    End With
End Sub

PS : '///modif veut dire "modification"

 

[gigiwin]

Re : Probleme mise en forme dans ma macro

Re,

Merci j'ai mes bordures.

Merci pour votre aide.

GIGIWIN