Mis en forme avec Macro

Fermé
cgtoitoine - 17 janv. 2012 à 15:07
Bonjour,



je suis en train de faire une analyse dans Excel (2010) : elle est nourrit par 2 requêtes.

Je souhaite mettre en évidence les sous-totaux en Gras et encadrés. Ces sous-totaux sont reconnaissables car ils n'ont pas de n° d'articles (contrairement aux autres lignes qui sont des articles) J'ai donc écrit cette macro :

Je supprime d'abord les formats et vide la colonne I.
En K2 se trouve une formule pour compter le nombre de ligne
Dans la colonne I je mets ma formule gauche;2 --> si c'est un chiffre c'est un article, sinon un sous total. (la fonction remplace sert à ce que Excel les passe en chiffre et non en standard comme par défaut)
Le test s'effectue en colonne H et la boucle fait la mise en forme.

Mais tous les sous totaux ne sont pas formatés comme souhaités.

Pouvez-vous m'aider ? Je ne trouve pas mon erreur.

Merci d'avance


Dim i As Integer
Dim j As Integer
Dim k As Boolean

    Range("H4:W1200").Select
    Selection.Font.Bold = False
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    Range("I4:I1200").Select
    Selection.ClearContents


    i = Range("K2").Value + 3

    Range("I4").Select
    ActiveCell.FormulaR1C1 = "=+LEFT(RC[1],2)"
    Range("I4").Select
    Selection.AutoFill Destination:=Range("I4:I" & i)
   
   
    Columns("I:I").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    Selection.Replace What:="1", Replacement:="1", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="2", Replacement:="2", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="3", Replacement:="3", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="4", Replacement:="4", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="5", Replacement:="5", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="6", Replacement:="6", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="7", Replacement:="7", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="8", Replacement:="8", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="9", Replacement:="9", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="0", Replacement:="0", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
     Range("H4").Select
     ActiveCell.FormulaR1C1 = "=+ISNUMBER(RC[1])"
     Selection.AutoFill Destination:=Range("H4:H" & i)
     
     For j = 5 To i
     
     k = Range("H" & j).Value
     
     If k = False Then
     Rows(j).Select
     Selection.Font.Bold = True
     With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
     j = j + 1
     
    Else:
    j = j + 1
     
    End If
    Next
    
    Columns("A:I").Select
     Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
     Selection.Font.Bold = False
    Columns("Q:IV").Select
     Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    Range("I2").Select
        
    
        
End Sub