Discussion :

[onejock]

bonjour,


j'ai un TCD avec en colonne des mois. l'idée est de colorier le mois en cours...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
' je selectionne les données
ActiveSheet.PivotTables("TCD-all").PivotSelect "", xlDataOnly, True

' j'efface les MFC précedentes
Selection.FormatConditions.Delete

'je crée ma mise en forme
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=SI(F$5=NOMPROPRE(TEXTE(AUJOURDHUI();""mmmm""));VRAI;FAUX)"

' j'affecte la modif
Selection.FormatConditions(1).Interior.ColorIndex = 40

mon problème est d'arriver a lui dire : tu prend F quand tu es sur la colonne F, G sur G, etc....



sinon, j'ai essayé de le faire sur la premier colonne puis de recopier sur les autres avec autofill mais je n'arrive pas a prendre que la Mise en forme conditionnelle (la recopie prend aussi la bordure, la couleur de fond, etc.,...)

merci d'avance

[onejock]

bon alors voila la fonction a copier-coller :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
50
51
52
53
54
 
 
 
' fonction qui colore les cellules appartenant à la colonne du mois en cours
Public Sub colorerMoisEnCours(pvtTable As PivotTable, Optional effacerAutresMFCSurMemesCellules As Boolean = True)
    ' ma collection de plage d'adresses fusionnées
    Dim moisAnnee As Variant
    moisAnnee = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")
 
    Dim adressCellMoisTmp As Range
    Dim lettreColonneTmp As String
    Dim chiffreLigneTmp As Integer
    Dim cellule As Range
    Dim colonneDonneesMoisTmp As Range
    Dim indiceTab As Integer
 
    ' pour chaque mois
    On Error Resume Next
    For indiceTab = 0 To UBound(moisAnnee)
        ' on recherche la colonne du mois
        pvtTable.PivotSelect moisAnnee(indiceTab), xlLabelOnly, True
        ' tant que le mois n'existe pas, rechercher le mois suivant (sauf pour le dernier)
        While Err.Number > 0
            Err.Clear
            If indiceTab < UBound(moisAnnee) Then
                indiceTab = indiceTab + 1
                pvtTable.PivotSelect moisAnnee(indiceTab), xlLabelOnly, True
            Else ' dernier mois absent --> sortir
                GoTo dernierMoisAbsent
            End If ' limite des indices
        Wend 'erreur : mois absent
        Set adressCellMoisTmp = Selection
 
        lettreColonneTmp = Chr(64 + adressCellMoisTmp.column) '65 etant le caractere "A"
        chiffreLigneTmp = adressCellMoisTmp.Row
 
        pvtTable.PivotSelect moisAnnee(indiceTab), xlDataOnly, True
        Set colonneDonneesMoisTmp = Selection
        For Each cellule In colonneDonneesMoisTmp
            With cellule
                ' effacer MFC sur les memes cellules
                If effacerAutresMFCSurMemesCellules Then
                    .FormatConditions.Delete
                End If
                .FormatConditions.Add Type:=xlExpression, Formula1:="=SI(" & lettreColonneTmp & "$" & chiffreLigneTmp & "=NOMPROPRE(TEXTE(AUJOURDHUI();""mmmm""));VRAI;FAUX)"
                .FormatConditions(1).Interior.ColorIndex = 40
            End With 'cellule
        Next cellule
    Next indiceTab
    pvtTable.Parent.Range("A1").Select
    On Error GoTo 0
Exit Sub
dernierMoisAbsent:
End Sub

voila, voila, merci à moi et bon courage aux autres...