Balises de dates en vba (ou MFC)

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

Je cherche a réaliser une petite maccro (ou MFC) pour mettre des bordures dans un planning en fonction de dates remplis en amont,
(voir image)

La MFC me semblait plus adaptée avec un INDEX+EQUIV (?) mais la bordure épaisse n'est pas gérée et le tableau a des ajouts régulier de lignes et donc de MFC (vite galère)

J'ai donc tenté la maccro mais j'ai trois morceaux que j'ai du mal à assembler, (je manque un peu de technique en vba :/)

1) Encadrer les cellules non vides d'un tableau
Code:

1 2 3 4 5 6 Sub encadrer_si() Dim cellule As Range For Each cellule In Range("XX:XX") If cellule <> "" Then cellule.Borders.Weight = xlThin Next End Sub
2) Mettre la bordure rouge à gauche de la cellule sélectionnée
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub Macro2() Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Color = -16776961 .TintAndShade = 0 .Weight = xlThick End With Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone End Sub
(brut d'enregistreur)

et 3) Application.match(.....) pour faire la recherche de date

Si une bonne âme peut me filer un coup de main je l'en serais fort reconnaissant :)

Merci à ceux qui prennent le temps de lire ! je peux détailler si besoin,

18/12/2017, 22h34
anasecu

Bonsoir,

Pour t'aider, il faudrait surtout que tu dises quelles couleurs tu veux et en fonction de quoi elles sont mises : c'est le principe de la MFC.

Ceci d'autant plus que tu parles de maj dates et qu'il n'y en a aucune dans ton tableau.
19/12/2017, 09h41
jerem5555

1 pièce(s) jointe(s)

Bonjour,

Merci de ton retour, J'ai remplacé les dates par des chiffres pour faire plus simple (ce qui a compliqué la compréhension..^^)

Les deux colonnes de gauche correspondent aux dates de début et dates de fin que l'on rentre manuellement,

et la ligne du haut aux dates du planning, le but est donc de créer une bordure de couleur (rouge : date de début et verte date de fin)

Suis-je plus claire ?Pièce jointe 335908

Bonjour ci dessous une base de reflexion

j'ai considérer que le planning est une zone fixe

"à adapter a la zone réelle"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Option Explicit
Dim lignehaut As Integer
Dim colonnehaut As Integer
Dim lignebas As Integer
Dim colonnebas As Integer
Dim colonne As Integer
Dim ligne As Integer
Dim zone
 
Sub colorier()
lignehaut = 7
colonnehaut = 3
lignebas = 12
colonnebas = 10
 
 
zone = (Cells(lignehaut, colonnehaut).Address & ":" & Cells(lignebas, colonnebas).Address)
 
     Range(zone).Borders(xlEdgeLeft).LineStyle = xlNone
     Range(zone).Borders(xlEdgeTop).LineStyle = xlNone
     Range(zone).Borders(xlEdgeBottom).LineStyle = xlNone
     Range(zone).Borders(xlEdgeRight).LineStyle = xlNone
     Range(zone).Borders(xlInsideVertical).LineStyle = xlNone
     Range(zone).Borders(xlInsideHorizontal).LineStyle = xlNone
 
For colonne = colonnehaut To colonnebas
For ligne = lignehaut To lignebas
 
If Cells(ligne, 2).Value = Cells(lignehaut - 1, colonne) Then
  With Cells(ligne, colonne).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = 4
        .ColorIndex = 3
    End With
End If
If Cells(ligne, 2).Value = Cells(lignehaut - 1, colonne) Then
  With Cells(ligne, colonne).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = 4
        .ColorIndex = 10
    End With
End If
Next
Next
 
End Sub

1 pièce(s) jointe(s)

solution

Merci beaucoup !! j'ai pu trouver une solution intéressante grâce à ton aide =)

Voici ma maccro pour les intéressés :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Option Explicit
Dim lignehaut As Integer '1ère ligne de la zone avec la mise en forme des barres
Dim colonnehaut As Integer '1ere colonne de la mise en forme des barres
Dim lignebas As Integer 'dernière ligne du tableau
Dim colonnebas As Integer 'dernière colonne du tableau
Dim colonnepourvert As Integer 'colonne où l'on retrouve la date pour la marque verte
Dim colonnepourrouge As Integer 'colonne où l'on retrouve la date pour la marque rouge
Dim decalage As Integer 'nombre de ligne entre la zone de marquage (tableau) et la ligne de lecture des dates
Dim colonne As Integer
Dim ligne As Integer
Dim zone
 
Sub colorier()
 
lignehaut = 5    '1ère ligne de la zone avec la mise en forme des barres
colonnehaut = 12 '1ere colonne de la mise en forme des barres
 
lignebas = Range("A" & Rows.Count).End(xlUp).Row 'Obtenir la dernière ligne du tableau
colonnebas = Cells(1, Columns.Count).End(xlToLeft).Column  'Obtenir la denière colonne du tableau
 
colonnepourvert = 7  'colonne où l'on retrouve la date pour la marque verte
colonnepourrouge = 8 'colonne où l'on retrouve la date pour la marque rouge
 
decalage = lignehaut - 1 'nombre de ligne entre la zone de marquage (tableau) et la ligne de lecture des dates
 
zone = (Cells(lignehaut, colonnehaut).Address & ":" & Cells(lignebas, colonnebas).Address)
 
For colonne = colonnehaut To colonnebas
For ligne = lignehaut To lignebas
 
 
If Cells(ligne, colonnepourrouge).Value = Cells(lignehaut - decalage, colonne) Then
  With Cells(ligne, colonne).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = 4
        .ColorIndex = 3
    End With
End If
If Cells(ligne, colonnepourvert).Value = Cells(lignehaut - decalage, colonne) Then
  With Cells(ligne, colonne).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = 4
        .ColorIndex = 10
    End With
End If
Next
Next
 
End Sub

un nouveau défi s'ouvre à moi :
Gérer la mise à jour lors d'un changement de date

Actuellement la nouvelle barre verte ou rouge s'ajoute sans supprimer l'ancienne :/
Je cherche donc a tester la zone de mise en forme pour détecter les cellules avec des barres vertes et rouges, et les supprimer,
Ainsi, lorsque je lance ma maccro elle supprimerai toutes les barres vertes et rouges (sans modifier le reste de la mise en forme) et créera a nouveau en fonction des dates présentes

je penses à un if Cells(ligne, colonne).Borders(xlEdgeRight).LineStyle = xlContinuous .Weight = 4 .ColorIndex = 3 Then copyformat Cells(ligne, colonne-1)

Est-ce envisageable selon vous ?

Cordialement,

Bonne année à tous !

/JMPièce jointe 339131

04/01/2018, 11h25
a_diard

Bonjour et meilleurs vœux.

Je pense que le plus simple est de commencer par réinitialiser les bordures gauches et droite de la zone:

Il me semble que le format est le même pour toutes les cellules de la zone.

A vérifier je pense que tu peux remplacer :

Code:

zone = (Cells(lignehaut, colonnehaut).Address & ":" & Cells(lignebas, colonnebas).Address)

Code:

zone = Range(Cells(lignehaut, colonnehaut), Cells(lignebas, colonnebas))

A vérifier.
09/01/2018, 13h24
jerem5555

oui merci en remettant les Range(zone).Borders gauche droite et intérieur vertical ça fonctionne ;)