Macro mise en forme par rapport à la date système

[cibleo]

Bonjour le forum

Voilà, la macro ci-dessous est censée m'appliquer un fond vert aux cellules de la colonne A dont la date est supérieure à la date système de mon ordinateur.

Sub DateSupCoul1()
Dim cell As Range, DerLiR As Long
DerLiR = Sheets("Synthese").Range("A65536").End(xlUp).Row
For Each cell In Range("A2:A" & DerLiR)
  'If cell.Value > CDate(Format(Date, "ddd dd mmm yy")) Then
  'If CDate(Format(cell.Value, "ddd dd mmm yy")) > CDate(Format(Date, "ddd dd mmm yy")) Then
  If Format(cell.Value, "ddd dd mmm yy") > Format(Date, "ddd dd mmm yy") Then
  cell.Interior.ColorIndex = 10
  Else 'Sinon
    cell.Interior.ColorIndex = xlNone 'la Couleur de la cellule est Transparente
  End If 'Fin de la condition
Next cell
End Sub

Nous sommes donc le dimanche 03 janvier 2010.

Le résultat n'est pas concluant voir ci-dessous.
Toute les dates se colorent en vert



Le format des cellules en colonne A : jjj jj mmm aa
La date système de l'ordinateur est bien réglée.

Qu'est-ce qui cloche ?

Cibleo

 

[Efgé]

Re : Macro mise en forme par rapport à la date système

Re à tous
J'ai resaisi vos dates en colonne A(au format date *01/01/2010) et ai appliqué le format personalisé indiqué. Tout fonctionne normalement.
Pour éviter ce problème essayez de modifier votre macro "remplirsynthese" avec:
ShtR.Cells(DerLiR, 1) = Format(£nomfeuille, "dddd dd mmm yy")
Sans garantie mais avec espoirs...
Cordialement

 

[Pierrot93]

Re : Macro mise en forme par rapport à la date système

Re

perso, je pense plutôt qu'il faudrait peut être intervenir sur le format de la cellule de destination, comme dans l'exemple ci-dessous :

With ShtR.Cells(DerLiR, 1)
    .Value = DateValue(£nomfeuille)
    .NumberFormat = "ddd dd mm yy"
End With

 

[phlaurent55]

Re : Macro mise en forme par rapport à la date système

Re à tous,

je pense que c'est cette ligne qui fout le B......

ShtR.Cells(DerLiR, 1) = Format(£nomfeuille, "ddd dd mmm yy")

tu récupères le nom de la feuille pour le mettre dans une cellule ET j'ai bien l'impression que ce n'est pas faisable étant donné le nom de la feuille qui ne ressemble à aucun format .
j'ai même essayé en mulitpliant par 1 ton £nomfeuille mais ça ne donne rien

DONC

d'abord renommer tes feuilles sans mettre les espaces

bon travail
à+
Philippe
.

 

[Pierrot93]

Re : Macro mise en forme par rapport à la date système

Re

@phlaurent "datevalue" ne fonctionne pas chez toi ?

 

[Efgé]

Re : Macro mise en forme par rapport à la date système

De mon côté j'ai renommer les onglets (du type 01012010). Rien à faire.
Peit être qu'en les nomant 01.01.2010 et en utilisant
.NumberFormat = "dd.mm.yyyy) .....
Le problème commence à dépasser mes maigres compérences.
Cordialement

 

[cibleo]

Re : Macro mise en forme par rapport à la date système

re à tous,

Pour info phlaurent55

L'instruction citée se trouve dans les 2 macros ci-dessous.

Private Sub remplirsynthese(£nomfeuille As Variant, Vsearch As String)
.../...

Private Sub remplirsynthese2(£nomfeuille As Variant, Vsearch As String)
.../...

A l'origine, les feuilles au format date sont dupliquées à partir d'un modèle.
voir la macro ci-dessous.

Sub Calendjourfeuille()
Application.ScreenUpdating = False
année = Val(InputBox("Quelle année ?"))
If année = 0 Then Exit Sub
X = DateSerial(année, 1, 1)
y = DateValue("31 décembre " & année)
For i = 0 To y - X
  If Weekday(X + i, vbMonday) < 6 Then
    Sheets("Planning").Copy After:=Worksheets(Worksheets.Count)
    [COLOR=darkred][B]With ActiveSheet[/B][/COLOR]
        .[B][COLOR=darkred]Name = Format(X + i, "dd mm yy")[/COLOR][/B]
        .[B1] = "Planning du " & Application.Proper(Format(X + i, "dddd dd mmmm yyyy"))
    End With
  End If
Next
End Sub

Efgé, cela ne fonctionne pas.

Par contre, après re-saisie manuelle des dates, les 3 macros fonctionnent.

Pierrot, je ne sais pas comme apporter ta modif dans les 2 procédures que j'ai citées plus haut ---> donc pas tester.

J'ai lu que VBA n'aimait pas les points dans les formats Date (réflexion de JP14)

Dans le programme, la macro ci-dessous applique une mise en forme générale de la Feuille "Synthese".

Private Sub [COLOR=red]miseenforme2[/COLOR]()
With ShtR
    DerLiR = .Range("a65536").End(xlUp).Row
    If DerLiR = 1 Then Exit Sub
    With .Range("A2:U" & DerLiR)
        '.ClearContents
        .Borders.LineStyle = xlNone
        .Characters.Font.FontStyle = "Normal"
        .Characters.Font.Size = 11
        .Characters.Font.Name = "verdana"
    End With
    With .Range("A2:B" & DerLiR)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
 
    [COLOR=darkred][B].Range("A2:A" & DerLiR).NumberFormat = "ddd dd mmm yy"[/B][/COLOR]
    .Range("N2:Q" & DerLiR).NumberFormat = "hh:mm"
    .Range("R2:U" & DerLiR).NumberFormat = "[hh]:mm"
.../...

Cibleo

 

[Pierrot93]

Re : Macro mise en forme par rapport à la date système

Re

dans la sub :

Private Sub remplirsynthese(£nomfeuille As Variant, Vsearch As String)

remplace cette ligne :

ShtR.Cells(DerLiR, 1) = Format(£nomfeuille, "ddd dd mmm yy")

par :

With ShtR.Cells(DerLiR, 1)
    .Value = DateValue(£nomfeuille)
    .NumberFormat = "ddd dd mm yy"
End With

@+

 

[cibleo]

Re : Macro mise en forme par rapport à la date système

re pierrot

Et bien voilà mon petit Pierrot , tu as trouvé la solution.

J'ai cru qu'on n'y arriverait pas avant la fin de la nuit

Je reteste quand même, et regarder de + près les fonctions de conversion, j'ai vraiment du mal à les comprendre en règle générale.

A+ Cibleo

 

[cibleo]

Re : Macro mise en forme par rapport à la date système

Bonsoir le forum,

Pour rajouter une condition, j'ai pensé à Switch en lieu et place de Iif.

3 conditions avec Iif, c'est impossible, pouvez-vous me le confirmer ?

Sub Couleur_date4()
Dim i As Long
For i = 2 To Range("A65536").End(xlUp).Row
        Cells(i, 1).Interior.ColorIndex = Switch(Cells(i, 1).Value [COLOR=darkred]< Date[/COLOR], xlNone, Cells(i, 1).Value [COLOR=navy]= Date[/COLOR], 5, Cells(i, 1).Value [COLOR=darkgreen]< Date[/COLOR], 11)
Next i
End Sub

Sinon, pour raccourcir l'instruction, peut-on éviter la succession de Cells(i, 1).Value

Je reviens demain avec une autre macro de mise en forme à créer.

A+ Cibleo

 

[Pierrot93]

Re : Macro mise en forme par rapport à la date système

Bonjour Cibleo

Oui, la fonction "IIf" ne renvoie que 2 arguments en fonction du test effectué, l'un si la condition est vérifiée, l'autre dans le cas contraire... On peut bien sur imbriquer plusieurs "IIF", mais dans le cas présent la fonction "swiitch" est un bon compromis.... Pour éviter la répétition des "Cells(i, 1)", tu peux utiliser un bloc "with" comme ci-dessous :

Dim i As Long
For i = 2 To Range("A65536").End(xlUp).Row
    With Cells(i, 1)
        .Interior.ColorIndex = Switch(.Value < Date, xlNone, .Value = Date, 5, .Value > Date, 11)
    End With
Next i

bonne journée
@+

 

[cibleo]

Re : Macro mise en forme par rapport à la date système

Bonsoir à tous,
Bonsoir Pierrot93,

J'ai enregistré ta modif et remis le fichier au post 14.

Le problème du format de la date renvoyée en colonne A est donc résolu.

J'aimerais donc appliquer une nouvelle macro à la feuille "Synthese".

Colonne A, si dans les cellules, le jour est 1 vendredi, j'aimerais appliquer une bordure inférieure formatée comme ci-dessous de la colonne 1 à 21.

Sub TestVend()
Dim cel As Range, DerLiR As Integer
DerLiR = Sheets("Synthese").Range("A65536").End(xlUp).Row
For Each cel In Range("A2:A" & DerLiR)
If Weekday(cel.Value, 1) = 6 Then
With .Range(Cells(2, 1), Cells(DerLiR, 21))
        [COLOR=blue]With Selection.Borders(xlEdgeBottom)[/COLOR]
[COLOR=blue]     .LineStyle = xlDot[/COLOR]
[COLOR=blue]     .Weight = xlThin[/COLOR]
[COLOR=blue]     .ColorIndex = 5[/COLOR]
[COLOR=blue] End With[/COLOR]
End With
End If
Next
End Sub

Pouvez-vous m'aider dans la rédaction de la macro ci-dessus ?
Ça n'a pas l'air de coller.

Cibleo

 

[cibleo]

Re : Macro mise en forme par rapport à la date système

Bonsoir à tous,

Suite au problème survenu ce week-end, je renouvelle ma demande ci-dessus et vous joint à nouveau mon fichier.

(fichier devenu non valide dans le post 14)

Cibleo

 

[Pierrot93]

Re : Macro mise en forme par rapport à la date système

Bonjour,

essaye peut être ainsi (non testé) :

Option Explicit
Sub TestVend()
Dim cel As Range, DerLiR As Integer
With Sheets("Synthese")
    DerLiR = .Range("A65536").End(xlUp).Row
    For Each cel In .Range("A2:A" & DerLiR)
        If Weekday(cel.Value, 1) = 6 Then
            With .Range(.Cells(2, 1), .Cells(DerLiR, 21))
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlDot
                    .Weight = xlThin
                    .ColorIndex = 5
                End With
            End With
        End If
    Next
End With
End Sub

bonne journée
@+

Edition : manquait les "end" "with" et "sub" restés dans le presse papier....

 

[cibleo]

Re : Macro mise en forme par rapport à la date système

Bonjour le forum,
Bonjour Pierrot93,

Elle marche la macro, mais je me suis mal exprimé

En fait, j'aimerais appliquer la bordure inférieure au niveau des lignes où figurent les vendredis.

Ici la macro applique la bordure inférieure à la dernière ligne de la feuille "Synthese" si elle a trouvé un Vendredi en colonne A.

Cibleo

 

[Pierrot93]

Re : Macro mise en forme par rapport à la date système

Re

remplace peut être la ligne ci-dessous :

With .Range(.Cells(2, 1), .Cells(DerLiR, 21))

par celle-ci :

With cel.Resize(, 21)

@+