Macro pour mise en forme d'un encadrement

Bonsoir le forum,

Dans un soucis de mise en forme de mon tableau situé dans l’onglet « Liste AF à compléter par DATES », je souhaiterai faire une macro qui me fasse un encadrement comme j'ai fait (en exemple) dans l’onglet « Modèle encadrement » du fichier joint. Concrètement je souhaiterai obtenir un trait plein vertical et horizontal autour de chaque formation identifiée par son code session en colonne « E » et un trait en pointillé entre chaque ligne qui compose la formation déterminée par le nombre en colonne « I » à partir de la colonne "J" (NUM DES PLACES).

La macro « Sub encadrement() qui se lance avec le bouton « encadrement » que j’ai commencée et qui se trouve dans le module4 me fait bien un encadrement mais en mettant des traits pleins à toutes les lignes et colonne sauf aux deux dernières lignes où elle me met bien les traits en pointillés.

Cordialement

Bonjour,

ça commence mal, plantage à l'ouverture. Pas sérieux ça...

    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlDash
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With

eric

Salut eriic

Je ne comprends pas pourquoi tu dis plantage à l'ouverture ???

A mon niveau je n'ai pas de plantage sauf que le résultat obtenu n'est celui voulu.

La macro entre les boucles a été faite avec le générateur de macro.

Cordialement

Salut le forum,

Je relance ma question pour savoir si une solution peut être trouvée à ma question ou si je dois classer sans suite. Merci.

Cordialement

Bonjour,

Je t'ai répondu non ?

Je t'ai mis ce qu'il fallait ajouter...

eric

Salut eriiic,

Je pensais que la réponse que tu m'avait faite était l'endroit où tu avais eu ton plantage car les lignes de code que tu m'as mises sont présentes à la fin de ma macro.

Si j'applique uniquement ces lignes de codes :

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlDash

.ColorIndex = xlAutomatic

.TintAndShade = 0

.Weight = xlThin

End With

seules sur un tableau sans encadrement j'aurai bien des pointillés à l'intérieur de mon tableau mais pas des traits pleins autour de chaque formation.

J'en déduis qu'il faut que je fasse une boucle pour avoir des traits plein (comme dans la macro de départ) puis une nouvelle boucle pour mettre juste les pointillé. Là ça marche mais je mets le double le temps d'exécution ce qui n'est pas rentable surtout quand je l'applique sur mon tableau réel où j'ai plus de 2500 lignes ce qui me fait 2500 lignes multiplié par 53 colonnes à passer deux fois...c'est long. Y-a-t-il pas une solution plus rapide pour obtenir le résultat souhaité ?

Cordialement.

Bonjour,

Bah j'ai répondu à ta question : avoir des pointillés au lieu de trait plein.

Maintenant si tu trouves que ta logique de traitement n'est peut-être pas la plus efficiente tu peux en changer :

mettre des pointillés hz partout en 1 fois, et faire les contours plage par plage ensuite.

eric

Salut,

Qu'est-ce que tu veux dire par "hz" ?

Faire le contour plage par plage c'est là mon problème car je n''arrive pas à savoir comment déterminer l'encadrement plage par plage. dans ma macro.

Cordialement.

hz = horizontal pour moi

Je n'avais pas compris que c'était ça ta question. Base-toi sur les fusions de cellule en I :

Sub encadrement()
    Dim c As Range, pl As Range
    Application.ScreenUpdating = False
    'détermine dernière ligne et dernière colonne de du tableau
    Flig = Range("I" & Rows.Count).End(xlUp).Row
    Fcol = Cells(2, Columns.Count).End(xlToLeft).Column

    ' intérieur
    With [J3].Resize(Flig - 2, Fcol - 9)
        ' horizontal
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlDash
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        ' vertical
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThick
        End With
    End With

    ' contour
    For Each c In [I3].Resize(Flig - 2)
        If c.Address = c.MergeArea(1).Address Then
            c.BorderAround
            Set pl = c.MergeArea.Offset(, 1).Resize(c.MergeArea.Rows.Count, Fcol - 9)
            pl.BorderAround LineStyle:=xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlThick
        End If
    Next c
End Sub

eric

Super c'est ça que j'attendais comme résultat. Cependant si ça marche pour les colonnes J et suivantes les colonnes de A à I restent sans encadrement si je pars d'un tableau vierge d'encadrement. Je n'arrive pas à voir dans la macro ce que je dois corriger pour "éliminer" ce petit détail. Un coup de pouce

Cordialement

Bon, met ton fichier avec une feuille brute sans que tu aies rien fait dessus (mais avec des données telles qu'elles sont au départ) car ensuite tu vas dire qu'il manque encore une partie.

Laisse une feuille formatée en exemple.

eric

Je t'ai mis un fichier avec ta macro dedans à la place de la mienne que j'ai renommée. Tu as un onglet "modèle encadrement" qui est le résultat final à obtenir. Tu verras qu'avec la nouvelle macro "encadrement" il y a seulement les colonnes à partir de J qui deviennent comme je souhaite avoir au final.

Cordialement.

les fusions sont faites d'origine et on peut compter dessus ou tu les as ajoutées ?

J'ai considéré que oui :

Sub encadrement()
    Dim c As Range, pl As Range
    Application.ScreenUpdating = False
    'détermine dernière ligne et dernière colonne de du tableau
    Flig = Range("I" & Rows.Count).End(xlUp).Row
    Fcol = Cells(2, Columns.Count).End(xlToLeft).Column

    ' intérieur
    With [J3].Resize(Flig - 2, Fcol - 9)
        ' horizontal
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlDash
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
    End With

    ' contour
    For Each c In [I3].Resize(Flig - 2)
        If c.Address = c.MergeArea(1).Address Then
            c.BorderAround
            Set pl = c.MergeArea.Offset(, -8).Resize(c.MergeArea.Rows.Count, Fcol)
            pl.BorderAround LineStyle:=xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlThick
            ' vertical
            With pl.Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThick
            End With
        End If
    Next c
End Sub

eric

Super Eriiic ta macro me donne le résultat attendu et en plus c'est bien plus rapidement qu'avec mes boucles de départ

Merci pour ton aide. Je mets la question en résolu.

Cordialement

Bonjour,

Tu peux enlever c.BorderAround, je ne sais pas pourquoi c'est resté là

C'est enlevé. Merci.