[VBA] Mise en forme selon date

[TheLio]

Bonjour amis forumeurs et formuleurs

Dans le fichier joint, la feuille compil est issue suite à une compilation triée par date (colonne H puis I) de plusieurs feuilles, opération faite par macro.

1. Pour des raisons de lisibilité, j'aimerai pouvoir comme dans l'exemple joint Supprimer la mise en forme existante de la ligne 7 à infini
2. Mettre une [bordure épaisse(cadre), lignes minces et colonnes traitillée ] à chaque changement de date en colonne H.

Pensez-vous que cela soit réalisable?
J'ai fait quelques vaines tentatives...
Merci pour votre coup de pouce
A++
Lio

 

[Pierrot93]

Re : [VBA] Mise en forme selon date

Bonjour TheLio

pour supprimer la mise en forme, essaye comme suit, si j'ai bien compris... :

Range("A7:I" & Range("A65536").End(xlUp).Row).ClearFormats

bonne journée
@+

 

[job75]

Re : [VBA] Mise en forme selon date

Bonjour TheLio, Pierrot,

Après l'effacement des formats, TheLio, je comprends que tu veux remettre en forme le tableau. A mon avis, la solution la plus simple est de le faire comme suit (dans une macro Worsheet_Change évidemment) :

- il y aura au dessus du tableau une ligne modèle (masquée) avec les formats voulus et bordure fine pour les lignes,

- copier le format de cette ligne et collage spécial sur tout le tableau

- balayage du tableau sur les dates et application d'une bordure plus épaisse où c'est nécessaire.

Le code n'est pas très compliqué à écrire, tu veux que je le fasse ou tu essaies par toi-même ?

A+

 

[Pierrot93]

Re : [VBA] Mise en forme selon date

Re, bonjour Job

regarde le code ci dessous pour la mise en forme, si cela peut t'aider :

Option Explicit
Sub test()
Dim i As Integer, j As Integer, c As Range, k As Byte
Range("A7:I" & Range("A65536").End(xlUp).Row).ClearFormats
For i = 7 To Range("A65536").End(xlUp).Row - 1
    If Cells(i, 8).Value = Cells(i + 1, 8).Value Then
        For j = i + 1 To Range("A65536").End(xlUp).Row
            If Cells(i, 8).Value <> Cells(j, 8).Value Or IsEmpty(Cells(j + 1, 8).Value) Then
                If IsEmpty(Cells(j + 1, 8).Value) Then k = 0 Else k = 1
                With Range(Cells(i, 1), Cells(j - k, 9))
                    With .Borders
                        .LineStyle = xlContinuous
                        .Weight = xlMedium
                        .ColorIndex = xlColorIndexAutomatic
                    End With
                    With .Borders(xlInsideVertical)
                        .LineStyle = xlDot
                        .Weight = xlThin
                        .ColorIndex = xlColorIndexAutomatic
                    End With
                    With .Borders(xlInsideHorizontal)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlColorIndexAutomatic
                    End With
                End With
                i = j - 1
                Exit For
            End If
        Next j
    Else
        With Range(Cells(i, 1), Cells(i, 9))
            With .Borders
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = xlColorIndexAutomatic
            End With
            With .Borders(xlInsideVertical)
                .LineStyle = xlDot
                .Weight = xlThin
                .ColorIndex = xlColorIndexAutomatic
            End With
        End With
    End If
Next i
End Sub

bonne journée
@+

 

[job75]

Re : [VBA] Mise en forme selon date

Re,

Bon alors voilà le fichier et mon code :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("H9:H65536")) Is Nothing Then Exit Sub
Dim derlig As Long, ref As Range, i As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Range("A9:I65536").ClearFormats
derlig = Range("H65536").End(xlUp).Row
If derlig < 9 Then GoTo 1
Set ref = Selection
Range("A8:I8").Copy
Range("A9:I" & derlig).PasteSpecial Paste:=xlPasteFormats
For i = 9 To derlig
  If Cells(i, 8).Value <> Cells(i + 1, 8).Value Then
    With Range(Cells(i, 1), Cells(i, 9)).Borders(xlEdgeBottom)
      .LineStyle = xlContinuous
      .Weight = xlMedium
      .ColorIndex = xlAutomatic
    End With
  End If
Next
ref.Select
Application.CutCopyMode = False
1 Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

A+

 

[TheLio]

Re : [VBA] Mise en forme selon date

Bonjour Pierrot, Job
Merci pour tout, grâce à votre code je vais pouvoir allonger ma pause café de 5 minutes quotidiennement lol
Merci Beaucoup
Lio