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 !!

 

[kingfadhel]

Bonsoir le forum, @bennp
à toi, reste la mise en page il faut que tu nous renseigne quelques infos de +
(paysage ou portrait,en tête et pied de page....)

 

[bennp]

Merci pour ta réponse, j'ai testé et il y a 1 choses que j'aimerais que tu améliore :

avant lorsque je sélectionnais n'importe quelle cellule en début de macro, le tableau commençait à la bonne cellule et maintenant ça ne fonctionne plus... par exemple j'ai sélectionné D12 en début de macro mais le tableau commence en A14. Peut-on tout décaler en fonction de la cellule sélectionnée ?

J'ai aussi rajouté une colonne en Feuil 1 pour voir si la mises en forme du tableau suivait mais non, ce qui est normal vu le code. Si tu peux, j'aimerais aussi que la couleur, le cadre, le nom centré en gras apparaisse aussi si une colonne s'ajoute.
Ce n'est pas obligatoire mais ça me permettra de rajouter d'autres tableaux différents sans trop modifier le code... Dis moi ce que tu en penses STP

 

[bennp]

une idée ?

 

[bennp]

@kingfadhel ?

 

[kingfadhel]

Bonjour,
je n'ai pas compris ce que tu veux dire avec:

Merci pour ta réponse, j'ai testé et il y a 1 choses que j'aimerais que tu améliore :

avant lorsque je sélectionnais n'importe quelle cellule en début de macro, le tableau commençait à la bonne cellule et maintenant ça ne fonctionne plus... par exemple j'ai sélectionné D12 en début de macro mais le tableau commence en A14. Peut-on tout décaler en fonction de la cellule sélectionnée ?

J'ai aussi rajouté une colonne en Feuil 1 pour voir si la mises en forme du tableau suivait mais non, ce qui est normal vu le code. Si tu peux, j'aimerais aussi que la couleur, le cadre, le nom centré en gras apparaisse aussi si une colonne s'ajoute.
Ce n'est pas obligatoire mais ça me permettra de rajouter d'autres tableaux différents sans trop modifier le code... Dis moi ce que tu en penses STP

 

[kingfadhel]

Re,
Voilà, espérant que tu trouve ton désir dans le fichier joint.

 

[bennp]

Merci pour ces modifs
regarde ce fichier, je sélectionne la cellule D12 et le tableau se met à partir de D12, mais du coup la mise en forme n'est plus bonne

Merci encore !

 

[kingfadhel]

RE,
@bennp, à toi de continuer la mise en forme

 

[bennp]

Génial merci !
je vais essayer d’adapter tout ça !!!

 

[bennp]

Bonjour,

j'essaie de passer un ligne entre dupont et le tableau, et entre durand et le tableau mais je n'y arrive pas, pour moi ça se situe dans cette partie là ?
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("a" & fin + 3 & ":K" & fin + 3).Select
Range(Cells(fin + 2, q), Cells(fin + 2, q + UBound(NomsColonnes))).Select ', Cells(x, q + UBound(NomsColonnes))).Select
Call entete
Else
fin = Sheets("Feuil2").Cells(Rows.Count, Selection.Column).End(xlUp).Row + 4 'on passe 4 lignes entre chaques tableaux
Range(Cells(fin + 2, q), Cells(fin + 2, q + UBound(NomsColonnes))).Select
Call entete

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("a" & fin + 3 & ":K" & fin + 3).Select
         Range(Cells(fin + 2, q), Cells(fin + 2, q + UBound(NomsColonnes))).Select ', Cells(x, q + UBound(NomsColonnes))).Select
         Call entete
     Else
         fin = Sheets("Feuil2").Cells(Rows.Count, Selection.Column).End(xlUp).Row + 4 'on passe 4 lignes entre chaques tableaux
         Range(Cells(fin + 2, q), Cells(fin + 2, q + UBound(NomsColonnes))).Select
         Call entete

j'ai tout essayé mais pas trouvé ... tu pourrais m'aider stp ?

 

[bennp]

autre chose tu pourrais écrire quelque chose 4 lignes en dessous du tableau avec la macro pour que je vois où insérer le nouveau code pour d'autres tableau et comment le faire stp ?

Merci

 

[bennp]

Pour ma 2ème demande c'est bon j'ai trouvé :

Next Nom
Range("a" & fin + 9).Select

 

[kingfadhel]

Bonjour,
Voilà

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
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 ', Cells(x, q + UBound(NomsColonnes))).Select
         Call entete
     Else
         fin = Sheets("Feuil2").Cells(Rows.Count, Selection.Column).End(xlUp).Row + 1
         Range(Cells(fin + 3, q), Cells(fin + 3, q + UBound(NomsColonnes))).Select
         Call entete
     End If
     Cells(fin + 1, Selection.Column) = UCase(Nom)
     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é
        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
                            k = Application.WorksheetFunction.Match(intitulé, NomsColonnes, 0) + Selection.Column - 1
                            Cells(Rows.Count, k).End(xlUp).Offset(1, 0) = tablo(i, j)
                        End If
                    Next intitulé
                End If
            Next j
        End If
    Next i
Next Nom
    x = Cells(Rows.Count, q).End(xlUp).Row
    Range(Cells(fin + 3, q), Cells(x, q + UBound(NomsColonnes))).Select
    Call Cadrage
Application.ScreenUpdating = True
End Sub

@+

 

[bennp]

Bonjour @kingfadhel

j'ai réussi à ajouter quelques cadrage mais ça ne le fait pas à tous mes tableaux, je ne vois pas comment l'insérer dans le code.

D'autre part je voudrais aussi ajouter "TOTAL" pour comptabiliser l'épaisseur et chiffre en appliquant une somme de chaque ligne, mais pareil je ne vois pas où insérer le code (à mon avis au même endroit que pour le cadrage, non ?)
voici le résultat souhaité

tu peux m'aider stp ?

Merci à toi