XL 2016 Mise en forme d'un tableau créé par macro

[bennp]

Bonjour, j'ai un tableau que je souhaiterais mettre en forme. Le problème est qu'il a été fait avec une macro et c'est donc compliqué pour moi de le mettre en forme :

Pour vous donner un aperçu j'ai copié / collé le tableau à côté et je souhaiterais :

Passer une ligne entre DUPONT et le tableau, idem pour les autres... et passer 2 lignes entre chaque tableaux, puis :

• hauteur ligne 15 et 23 = 30 et en Gras et retour à la ligne automatique, fond en RVB(142 ,169 ,219)
• Colonne P et S : centrer horizontalement et verticalement (pas la colonne L) et arrondir 0.00
• colonne P : multiplier chaque cellulle par 1000
• Contours dessiné du tableau en color(RVB) (128, 128, 128) comme indiqué sur le fichier

Bien sûr il faudrait mettre en page que cette partie et pas ce qui est au dessus, ni en dessous du tableau.
Le nombre de tableaux peut être différent (DUPONT, DURAND) et à l'intérieur de chaque tableau, il y a un nombre de lignes différent.

Voilà, j’espère être compréhensible...
Merci du coup de main !!

 

[cp4]

un essai pour le cadrage, ta macro corrigée en retour

Sub Recuperer()
    Dim tablo() As Variant
    Dim NomsColonnes() As Variant
    p = Selection.Row
    q = Selection.Column
    Set MonDico = CreateObject("Scripting.Dictionary")
    'Sheets("Feuil2").Range("A15:AN9000" & fin).Clear
    Sheets("Feuil2").Rows("12:37000").Delete Shift:=xlUp
    Dernli = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row     'variable non utilisée
    NomColonneCherchée = "Nom"
    With Sheets("Feuil1").Rows(1)    'on cherche dans la ligne 1 de la feuile Feuil1
        Set c = .Find(NomColonneCherchée)
        If Not c Is Nothing Then
            col = c.Column
        Else
            MsgBox "Pas trouvé le nom "
        End If
    End With
    tablo = Sheets("Feuil1").UsedRange.Value    'on récupère l'ensemble des data de la feuille Feuil1
    'on récupère la liste des noms sans doublon de la colonne "col" que l'on met dans un dictionnaire
    For i = LBound(tablo, 1) + 1 To UBound(tablo, 1)    'lbound+1 pour éviter la ligne d'entete
        If tablo(i, col) <> "" Then MonDico(tablo(i, col)) = ""
    Next i
    NomsColonnes = Array("Fruit", "", "", "", "épaisseur", "", "", "chiffre")
    For Each Nom In MonDico.keys    'pour chaque nom contenu dans le dictionnaire
        If IsEmpty(fin) Then
            fin = Selection.Row + 1
            Range(Cells(fin + 3, q), Cells(fin + 3, q + UBound(NomsColonnes))).Select    '(fin + 3 --> écart 1 ligne entre dupont et tableau
            Call entete
            Call Cadrage
        Else
            fin = Sheets("Feuil2").Cells(Rows.Count, Selection.Column).End(xlUp).Row + 5    '+5 --> écart entre chaque tableau
            Range(Cells(fin + 3, q), Cells(fin + 3, q + UBound(NomsColonnes))).Select    '(fin + 3 --> écart 1 ligne entre dupont et tableau
            Call entete
            Call Cadrage
        End If
        Cells(fin + 1, Selection.Column) = UCase(Nom)
        Rows(fin + 3).RowHeight = 30    '(fin + 3 --> écart 1 ligne entre dupont et tableau
        Cells(fin + 1, Selection.Column).Font.Bold = True
        i = 1
        For Each intitulé In NomsColonnes
            Sheets("Feuil2").Cells(fin + 1, Selection.Column).Offset(2, i - 1) = intitulé    '(fin + 1 --> écart 1 ligne entre dupont et tableau
            i = i + 1    ''
        Next intitulé
        For i = LBound(tablo, 1) To UBound(tablo, 1)    'pour chaque ligne du tablo
            If UCase(tablo(i, col)) = UCase(Nom) Then    'si on est sur le bon nom
                For j = LBound(tablo, 2) + 1 To UBound(tablo, 2)    'pour chaque colonne
                    If tablo(i, j) <> "" Then    's'il y a quelque chose
                        For Each intitulé In NomsColonnes
                            If tablo(1, j) = intitulé Then
                                If intitulé = "épaisseur" Then
                                    k = Application.WorksheetFunction.Match(intitulé, NomsColonnes, 0) + Selection.Column - 1
                                    Cells(Rows.Count, k).End(xlUp).Offset(1, 0) = (tablo(i, j) * 100)
                                Else
                                    k = Application.WorksheetFunction.Match(intitulé, NomsColonnes, 0) + Selection.Column - 1
                                    Cells(Rows.Count, k).End(xlUp).Offset(1, 0) = tablo(i, j)
                                End If
                            End If
                        Next intitulé
                    End If
                Next j
            End If
        Next i
        x = Cells(Rows.Count, q).End(xlUp).Row
        Range(Cells(fin + 4, q), Cells(x, q + UBound(NomsColonnes))).Select    '(fin + 3 --> écart 1 ligne entre dupont et tableau
        Call Cadrage
    Next Nom
    Application.ScreenUpdating = True
End Sub

ta variable Dernli n'est ni déclarée, ni utilisée au sein de ta macro

    Dernli = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

Pour le total pioche du côté de la fonction 'sous total'.
bonne continuation

 

[bennp]

ok merci je vais regarder

 

[bennp]

Bon...j'ai réussi à insérer "TOTAL"
J'ai commencé à écrire la somme, c'est la bonne case mais la formule est recopiée dans la cellule et non appliquée :

Cells(x + 1, q - 3 + UBound(NomsColonnes)).Select
        ActiveCell.FormulaR1C1 = "=SUM(Range(Cells(fin + 4, q + 4), Cells(x +1, q - 2 + UBound(NomsColonnes))))"

j'ai dû faire une erreur quelque part. Quelqu'un a une idée ?

 

[bennp]

c'est bon j'ai trouvé !!

        Cells(x + 1, q - 3 + UBound(NomsColonnes)).Select
        ActiveCell.Formula = "=SUM(" & Range(Cells(fin + 4, q + 4), Cells(x, q - 3 + UBound(NomsColonnes))).Address & ")"

 

[bennp]

Lorsque je transpose ma macro à mon fichier, tout mon texte est en centré alors que dans le fichier que je vous transmet il est bien aligné à gauche ? Même si je mets tout à gauche avant de lancer la macro

 

[kingfadhel]

Lorsque je transpose ma macro à mon fichier, tout mon texte est en centré alors que dans le fichier que je vous transmet il est bien aligné à gauche ? Même si je mets tout à gauche avant de lancer la macro

Bonjour, le fil, le forum,

pour résoudre ce problème,
sélectionne toute la feuille et tu mets le tout aligné à gauche.

 

[bennp]

Oui je sais bien mais le problème est que dans mon code tout ne doit pas être à gauche et si je fais cette manip avant, ça met quand même tout au centre

 

[cp4]

Lorsque je transpose ma macro à mon fichier, tout mon texte est en centré alors que dans le fichier que je vous transmet il est bien aligné à gauche ? Même si je mets tout à gauche avant de lancer la macro

Non même sur ton fichier joint tout est centré. Normal, tu utilises macro 'cadrage' pour centrer le contenu des cellules. Revois ta macro.

 

[bennp]

même dans l'exemple c'est au milieu, je vais essayer de rajouter du code..

 

[kingfadhel]

Re,
Mise à jour:

• Cellule total + calcul Total + cadrage
• Sub Cadrage (alignement + réduction du code)