Mise en page spécifique à répéter sur même feuille

[techie59]

Bonjour à tous,

Comme d'habitude, je reviens vers vous pour m'aider sur un problème Excel car je sais que vous allez me trouver la solution très rapidement.
Voici mon problème.

Dans notre système ERP, nous avons une fonction qui nous permet d'exporter les données en format CSV. Nous ouvrons le document, on fait en sorte de valider les données d'import mais le "look" du rapport est vraiment très moche alors que nous souhaiterions pouvoir l'envoyer à nos clients. Je sais comment faire une macro simple avec enregistrement pour enregistrer les manipulations de mise en forme mais j'ai besoin de le faire plusieurs fois à l'intérieur d'un même onglet pour différencier les sections pour chaque article/produit.
Je vous joins un document pour que vous puissiez mieux comprendre "grilles.xlsx".

Chaque ligne "Customer Item" représente en fait le début d'une nouvelle section pour lequel je souhaite appliquer le même style que je pourrais enregistrer sous la forme d'une macro (à enregistrer en faisant la mise en page). Par contre, la taille de la section varie en fonction de l'information présente (des fois une ligne, parfois 2 ou plus).

Quelle est la fonction pour demander à Excel d'executer une mise en forme spécifique à chaque changement de section? Et comment fait-on si la taille de la section varie (je sais uniquement faire une selection total mais pas partiel).

J'espère avoir été clair et que vous avez compris mon problème. Merci d'avance pour votre aide, toujours aussi utile.

Techie59

 

[klin89]

Re : Mise en page spécifique à répéter sur même feuille

Bonsoir le forum, techie59

Un début de réponse :

Sub essai()
Dim myAreas As Areas, myArea As Range, i As Long
    Application.ScreenUpdating = False
    With ActiveSheet.UsedRange
        For i = .Rows.Count To 1 Step -1
            If WorksheetFunction.CountA(.Rows(i)) = 0 Then
                .Rows(i).EntireRow.Delete
            End If
        Next i
    End With
    Columns(1).Insert
    With Range("b1", Range("b" & Rows.Count).End(xlUp)).Offset(, -1)
        .Formula = "=if(left(b1,13)=""Customer Item"",1,"""")"
        .Value = .Value
        On Error Resume Next
        Columns(1).SpecialCells(2, 1).EntireRow.Insert
        'si l'on conserve la formule en colonne A
        'Columns(1).SpecialCells(-4123, 1).EntireRow.Insert
        'équivaut à
        'Columns(1).SpecialCells(xlCellTypeFormulas, 1).EntireRow.Insert
        On Error GoTo 0
    End With
    Columns(1).Delete
    On Error Resume Next
    Set myAreas = Columns(1).SpecialCells(2).Areas
    On Error GoTo 0
    If myAreas Is Nothing Then Exit Sub
    For Each myArea In myAreas
        'Mise en forme de chaque zone
        'A compléter
        With myArea.CurrentRegion
            With .Cells(1)
                .Resize(3).BorderAround ColorIndex:=1, Weight:=2
                .Interior.ColorIndex = 19
                .Offset(1).Interior.ColorIndex = 36
                .Offset(2).Interior.ColorIndex = 44
            End With
            .Borders(xlInsideVertical).Weight = xlThin
            .BorderAround ColorIndex:=3, Weight:=3
        End With
    Next
    'On Error Resume Next
    'Columns(1).SpecialCells(4).EntireRow.Delete
    'On Error GoTo 0
    Columns(1).AutoFit
    Set myAreas = Nothing
    Application.ScreenUpdating = True
End Sub

Klin89

 

[klin89]

Re : Mise en page spécifique à répéter sur même feuille

Re techie59

La colonne 1 contient quelques cellules vides, je bouclais 17 fois au lieu de 15 avec le code précédant.
J'ai gommé les imperfections ci dessous, 15 zones ---> 15 itérations

Sub essai()
Dim myAreas As Areas, myArea As Range, i As Long, n As Long
    Application.ScreenUpdating = False
    With ActiveSheet.UsedRange
        For i = .Rows.Count To 1 Step -1
            If WorksheetFunction.CountA(.Rows(i)) = 0 Then
                .Rows(i).EntireRow.Delete
            End If
        Next i
        .VerticalAlignment = xlCenter
        n = .Columns.Count
    End With
    Columns(1).Insert
    With Range("b1", Range("b" & Rows.Count).End(xlUp)).Offset(, -1)
        .Formula = "=if(left(b1,13)=""Customer Item"",1,""a"")"
        .Value = .Value
        On Error Resume Next
        Columns(1).SpecialCells(2, 1).EntireRow.Insert
        On Error GoTo 0
    End With
    On Error Resume Next
    Set myAreas = Columns(1).SpecialCells(2).Areas
    On Error GoTo 0
    If myAreas Is Nothing Then Exit Sub
    For Each myArea In myAreas
        'Mise en forme de chaque zone
        With myArea.CurrentRegion
            With .Cells(1).Offset(, 1)
                .Resize(3).BorderAround ColorIndex:=1, Weight:=2
                .Interior.ColorIndex = 19
                .Offset(1).Interior.ColorIndex = 36
                .Offset(2).Interior.ColorIndex = 44
            End With
            .Offset(, 1).Resize(, .Columns.Count - 1).Borders(xlInsideVertical).Weight = xlThin
            .Offset(, 1).Resize(, .Columns.Count - 1).BorderAround ColorIndex:=3, Weight:=3
        End With
    Next
    'On Error Resume Next
    'Columns(1).SpecialCells(4).EntireRow.Delete
    'On Error GoTo 0
    Columns(2).Resize(, n).AutoFit
    Columns(1).Delete
    Set myAreas = Nothing
    Application.ScreenUpdating = True
End Sub

Klin89