Bordures automatiques

papillon28400 · 3 Décembre 2008

Bonjour,
J'ai un fichier excel qii s'alimente à l'aide d'une macro (remplissage) qui lance une procédure Visual Basic. Développement fait à partir de l'aide précieuse d'un membre de notre communauté.
Il y a deux dates à saisir et ensuite les autre s'alimentent automatiquement.
Suivant les dates saisies, le nombre de lignes peut varier d'un cas à l'autre, mais dans tous les cas les longueurs de chaque colonne est identique.
J'aimerais créer une procédure afin que les bordures se fassent automatiquement, quelque soit le nombre de lignes. Le nombre de colonne est quant à lui figé.
Merci d'avance pour votre aide.
Cordialement

Kotov · 3 Décembre 2008

Re : Bordures automatiques

Bonjour Papillon,

Je te propose le code suivant qui sélectionne la plage de données contigües à partir de la cellule A1 (à adapter à ton tableau)

Code:

Sub Bordures()
[color=red]Cells(1, 1)[/color].CurrentRegion.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

Bonne soirée

Kotov

JNP · 3 Décembre 2008

Re : Bordures automatiques

Bonjour Papillon28400, Kotov 🙂,
Le temps que je lise ton MP, j'ai vu que tu avais posté un nouveau fil et que Kotov t'avais fait une proposition. Son code devrait fonctionner sans problème (il sélectionne toutes les cellules proches de la cellule désignée et les formate avec bordures).
Pour tes largeurs de colonnes, les intructions suivantes devraient faire l'affaire :

Code:

    Columns("B:C").Select [COLOR=seagreen]' remplacer B:C par toutes les colonnes concernées[/COLOR]
    Selection.Columns.AutoFit

Bon courage 😎

papillon28400 · 4 Décembre 2008

Re : Bordures automatiques

Bonjour,

Merci beaucoup à vous deux,
Grâce à vous, tout à l'air de fonctionner.
A part, si l'on saisi (mais là, c'est peut être un cas extrême) :

en date de naissance : 1/01/1925
date d'autonomie : 1/01/1965

Si vous trouvez, je vous en remercie d'avance.
Bonne journée à vous tous.

Cordialement

JNP · 4 Décembre 2008

Re : Bordures automatiques

Bonjour le forum 🙂,
En ouvrant ton fichier, j'ai vu que tu as perdu la division par 3 du nombre de mois pour que la variable Hauteur soit correcte. D'autre part, l'adaptation de mon code de départ pour décaler de 19 lignes me parait bizare, car on ne devrait pas s'arrêter en 01/12/64... J'y jettes un oeil.
Bonne journée 😎

JNP · 6 Décembre 2008

Re : Bordures automatiques

Bonjour le forum 🙂,
Effectivement, il trainait quelques petites erreurs dans mon code. Je les ai corrigées, il te reste à le réadapter sur la hauteur. Attention, le test sur la hauteur (divisé par 3) permet de vérifier si la division est juste. Sinon, il rajoute 1. Ce test ne fonctionnait pas à cause d'une mauvaise déclaration de variable (Integer), mais maintenant, c'est bon. Ne le passe surtout pas à 19... D'autre part, j'ai ajouté 1 avant la division (l'éternelle différence entre les étapes et les intervales...). Je t'ai mis en bleu les seules valeurs à adapter.

Code:

Sub Remplissage()
Range[B][COLOR=blue]("a2", "j500").[/COLOR][/B]ClearContents
Dim Début As Date, Fin As Date, DateIntermédiaire As Date, [COLOR=red][B]Hauteur As Double[/B][/COLOR], I As Integer
On Error GoTo Sortie
Début = InputBox("Date de début ?")
Fin = InputBox("Date de fin ?")
On Error GoTo 0
If Fin < Début Then Exit Sub
DateIntermédiaire = Début
Hauteur = ((Month(Fin) + Year(Fin) * 12) - (Month(Début) + Year(Début) * 12) [COLOR=red][B]+ 1[/B][/COLOR]) / 3
If Hauteur <> Int(Hauteur) Then Hauteur = Int(Hauteur) [COLOR=red][B]+ 1[/B][/COLOR]
For I =[B][COLOR=blue]2[/COLOR][/B]To Hauteur [B][COLOR=blue]+ 1[/COLOR][/B]
Cells(I, 3) = DateIntermédiaire
Cells(I, 6) = DateAdd("m", Hauteur, DateIntermédiaire)
If DateAdd("m", Hauteur * 2, DateIntermédiaire) <= Fin Then
    Cells(I, 9) = DateAdd("m", Hauteur * 2, DateIntermédiaire)
End If
DateIntermédiaire = DateAdd("m", 1, DateIntermédiaire)
Next I
For I = [COLOR=blue][B]2[/B][/COLOR] To Hauteur [COLOR=blue][B]+ 1[/B][/COLOR]
If Month(Cells(I, 3)) = Month(Début) Then Cells(I, 1) = Year(Cells(I, 3)) - Year(Début)
If Month(Cells(I, 6)) = Month(Début) Then Cells(I, 5) = Year(Cells(I, 6)) - Year(Début)
If Month(Cells(I, 9)) = Month(Début) Then Cells(I, 8) = Year(Cells(I, 9)) - Year(Début)
Next I
Exit Sub
Sortie: Exit Sub
End Sub

Bonne journée 😎

Bordures automatiques

papillon28400

Guest

Pièces jointes

Kotov

XLDnaute Impliqué

JNP

XLDnaute Barbatruc

papillon28400

Guest

JNP

XLDnaute Barbatruc

JNP

XLDnaute Barbatruc

Discussions similaires

Bordures automatiques

papillon28400

Guest

Pièces jointes

Kotov

XLDnaute Impliqué

JNP

XLDnaute Barbatruc

papillon28400

Guest

JNP

XLDnaute Barbatruc

JNP

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency