Remplir un calendrier

Bonjour à tous,

Comment en VBA peut-on remplir un calendrier ?

Merci d'avance.

Bonsoir !

Remplir,... càd ?

Bonjour Ginga999,

Création d'un tableau de jours pour chaque mois.

Bonjour

Avec des formules et des mises en formes conditionnelles

Cordialement

Bonjour Amadéus,

Merci pour l'exemple.

Mais ne peut-on pas utiliser ces formules dans un code VBA ?

En plus il y a bien une colonne pour savoir le numéro de semaine ?

Bonjour

avec les Nos de semaines

Pour VBA, Je ne sais pas..

Cordialement

Bonjour,

Voila un essai en VBA, mais malheureusement les mois ne sont pas remplis correctement ainsi que les numéros des semaines !

Sub test()
    Dim Mois As Integer, Jour As Integer, m As Long
    Dim dDate As Date, Ligne As Byte

    Ligne = 3
    For m = 1 To 12
        dDate = Format(DateSerial(Year(Date), Month(Date), 1), "dd/mm/yy")
        Mois = m
        MsgBox "Mois : " & m
        Jour = 0

        With Feuil2
            .Range("A1").Value = Application.Proper(Format(DateSerial(2015, Mois, 1), "mmmm"))

            ' Efacement de la zone du mois
            [modele].Offset(3).ClearContents

            For i = 3 To 8
                For j = 1 To 7
                    Debug.Print "Colonne : " & .Cells(i, j).Column, "Weekday : " & Weekday(dDate, 2)    'Weekday(#1/1/2015#, 2)
                    Debug.Print "Mois : " & Month(DateSerial(2015, Mois, Jour)), "Mois jour-1 : " & Month(DateSerial(2015, Mois, Jour - 1))
                    If i = 3 And .Cells(i, j).Column < Weekday(dDate, 2) Then
                        Cells(i, j) = ""
                    Else
                        Jour = Jour + 1
                        If Jour <= Day(DateSerial(2015, Mois, 0)) Then
                            .Cells(i, j) = Jour
                            If Jour = 1 Then .Cells(i, j).Font.ColorIndex = 3
                        End If
                    End If
                Next j
                If j = 8 And Application.CountA(.Range(.Cells(i, 1), .Cells(i, 8))) > 0 Then
                    .Cells(i, j) = ""
                    .Cells(i, 8) = Application.WeekNum(DateSerial(2015, Mois, _
                                                                  Application.Min(.Range(.Cells(i, 3), .Cells(i, 8)))))

                End If

            Next i
            If m Mod 2 <> 0 Then
                [modele].Copy Feuil1.Range("A" & Ligne)

            Else
                [modele].Copy Feuil1.Range("J" & Ligne)
                Ligne = Ligne + 9
            End If
        End With
    Next m
End Sub

Bonjour,

Manque-t-il quelque chose ?