XL 2010 Format date(Résolu)

[Kael_88]

Le forum,

Comment puis-je mettre dans la même cellule des dates en continue et d'ordre croissant, avec la date système au bout.

Ce que j'arrive a faire :

Range("B4") = Date - 3 & " - " & Date - 2 & " - " & Date - 1 & " - " & Date
24/04/2018 - 25/04/2018 - 26/04/2018 - 27/04/2018

Ce que je veux afficher :
24/04 - 25/04 - 26/04 - 27/04/2018

Plus si possible, me demander combien de jours a afficher dans la cellule ,
exemple si 1 alors 27/04/2018 si 3 alors 25/04 - 26/04 - 27/04/2018

Cordialement

 

[job75]

Bonjour Kael_88, le forum,

Sub Test()
Dim nmax, x$, n, a$(), datini&
nmax = 100 'modifiable
Do
    x = InputBox("Nombre de jours (maximum " & nmax & ") :", , x)
    If x = "" Then Exit Sub
    n = Int(Val(x))
Loop While n < 1 Or n > nmax
ReDim a(n - 1)
datini = Date - n + 1
For n = 0 To UBound(a) - 1
    a(n) = Format(datini + n, "dd/mm")
Next
a(n) = Date
Range("B4") = Join(a, " - ")
End Sub

Bonne journée.

 

[Kael_88]

Le forum, job75,

Merci de partager ton savoir, cela fonctionne nickel, comme d'habitude.

Cordialement

 

[job75]

Re,

Si la période à afficher comprend plusieurs années il faut indiquer l'année pour la 1ère date et pour les 1ers janvier.

Exécutez cette macro en choisissant 1000 jours :

Sub Test()
Dim nmax, x$, n, a$(), datini&
nmax = 2000 'modifiable
Do
    x = InputBox("Nombre de jours (maximum " & nmax & ") :", , x)
    If x = "" Then Exit Sub
    n = Int(Val(x))
Loop While n < 1 Or n > nmax
ReDim a(n - 1)
datini = Date - n + 1
a(0) = Format(datini, "dd/mm" & IIf(Year(datini) < Year(Date), "/yyyy", ""))
For n = 1 To UBound(a) - 1
    a(n) = Format(datini + n, "dd/mm")
    If a(n) = "01/01" Then a(n) = a(n) & "/" & Year(datini + n)
Next
a(n) = Date
'---affichage---
Application.ScreenUpdating = False
ActiveWindow.Zoom = 100
With Range("B4")
    .ColumnWidth = 200 'largeur à adapter
    .RowHeight = 409 'hauteur maximum
    .WrapText = True 'renvoi à la ligne
    .Font.Size = 12
    .Value = Join(a, " - ")
    For n = 1 To 20
        .Rows.AutoFit 'ajustement
        If .RowHeight > 400 Then .Font.Size = 12 - n / 2 Else Exit For 'diminution de la taille de la police
    Next
    Application.Goto .Cells, True 'cadrage
End With
End Sub

Déjà avec 1000 jours il faut faire une petite gymnastique pour arriver à tout afficher dans la cellule...

Edit : j'ai tenté de jouer avec le zoom mais en fait il faut le maintenir à 100.

A+