Discussion :

[druidoes200]

Bonjour à tous et à toutes .

Voilà j'ai un problème, je vous l'explique, je désirerai remplir mon calendrier par les numéros de jours, en fonction du mois et de l'année, le tout ne devant pas dépasser la limite de la largeur et de la hauteur du tableau. Hélas je ne sais pas comment commencer du tout, c'est pour cela que je vous demande de l'aide. Si vous pouvez m'éclairer, je vous en serai reconnaissant. Merci d'avance Calendrier.xlsm

[Al__22]

https://www.developpez.net/forums/d8...s-discussions/

[druidoes200]

Je n'ai pas demandé qu'on me fasse directement le travail, mais si on pouvait m'aider en m'expliquant comment commencer, j'ai joint mon fichier pour que ça soit plus simple à comprendre et pour que vous sachiez comment je voudrai que ça soit fait

[Al__22]

As-tu déjà paramétré ton UserForm du coup ?

[unparia]

Bonjour

j'ai joint mon fichier pour que ça soit plus simple à comprendre et pour que vous sachiez comment je voudrai que ça soit fait

Très mauvaise idée. Lis ma signature. Je suis loin d'être le seul à ne pas accepter d'ouvrir un classeur tiers.
Tu dois être capable, si ton projet et bien pensé, de l'exposer très précisément.

[druidoes200]

Oui, j'ai déjà paramétré mon UserForm

unparia, je vous comprends, j'aurai sûrement fait de même à votre place.
Cela fait déjà plus d'une semaine déjà que j'essaie, mais rien ne va

[Invité]

Code :

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

1
2
3
4
Sub test()
Const j = 1, m = 5, y = 2017
Debug.Print DateSerial(y, m, j)
End Sub

[Docmarti]

Bonjour.

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
Sub Bouton6_Clic()
 
Set f = ActiveSheet
 
Set cellule0 = f.Cells(15, "D")
 
interligne = 2
 
cellule0.Offset(1, 1).Resize(6 * interligne, 7).ClearContents
 
mois = 6
annee = 2017
 
ladate = DateSerial(annee, mois, 1)
 
jour = Weekday(ladate, vbUseSystemDayOfWeek)
precedent = jour
semaine = 1
 
While Month(ladate) = mois
 
cellule0.Offset(semaine * interligne, jour).Value = Day(ladate)
 
cellule0.Offset(semaine * interligne, jour).Select
 
ladate = ladate + 1
 
jour = Weekday(ladate, vbUseSystemDayOfWeek)
If jour < precedent Then
 semaine = semaine + 1
End If
precedent = jour
 
Wend
 
End Sub

[patricktoulon]

bonjour ca devrait faire l'affaire selon ton tableau dans ta piece jointe

Code :

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

1
2
3
Sub test()
    create_calendrier 2017, 2 'année puis mois
End Sub

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
Function create_calendrier(année, mois)
    Dim i As Long, col As Long, lig As Long, nbjour As Long
    nbjour = Day(DateSerial(année, mois + 1, 0)) ' te donne le nombre de jour dans le mois en parametre
    col = Weekday(DateSerial(année, mois, 1)) - 1    ' te donne la colonne(l'index du jour de la semaine ), ajouter la différence si le calendrier ne commence pas en colonne "A"
    If col = 0 Then col = 7
    lig = 3
    With Sheets(1)
        .Range(.Cells(3, 1), .Cells(14, 7)).ClearContents
        For i = 1 To nbjour
            If col = 8 Then lig = lig + 2: col = 1
            .Cells(lig, col) = i
            col = col + 1
        Next
        .Cells(1, 1) = Format(DateSerial(année, mois, 1), "mmmm  ") & année
    End With
End Function

[Nicolas JACQUIN]

Bonjour à tous,
Je me suis permis de reprendre le joli code de Patricktoulon (Merci ), enfaite je suis parti avec une validation des données en A1 pour l'année, et pareil en B1 pour les mois,
pour avoir automatiquement un beau calendrier en changeant le mois ou l'année, Vous trouverez ci dessous le code modifié,
sans doute avec quelque arrangement à faire (suis débutant et j'aime apprendre).
J'attends vos conseils pour aider tous ce qui souhaite en profiter.

Code :

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

1
2
3
4
5
6
Private Sub Worksheet_Change(ByVal Target As Range)
 
If Not Intersect(Target, Range("A1")) Is Nothing Then Call Calendrier
If Not Intersect(Target, Range("B1")) Is Nothing Then Call Calendrier
 
End Sub

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
Sub Calendrier()
 
Dim col&, an&, nbjour&, lig&, j&
Dim mo$, l$
Dim m%, n%, k%, o%
an = Worksheets("Feuil1").Range("A1").Value: mo = Worksheets("Feuil1").Range("B1").Value
k = Month(DateValue(mo & ", 0")): nbjour = Day(DateSerial(an, k + 1, 0))
col = Weekday(DateSerial(an, k, 1)) - 1
If col = 0 Then col = 7
lig = 4
    With Worksheets("Feuil1")
    Range(Cells(3, 1), Cells(20, 7)).ClearContents
    Range(Cells(3, 1), Cells(20, 7)).Interior.Pattern = xlNone
    Range(Cells(3, 1), Cells(20, 7)).Borders.LineStyle = xlLineStyleNone
For j = 1 To nbjour
l = Format((j & "/" & k & "/" & an), "dddd")
m = Day(Date)
n = Month(Date)
o = Year(Date)
    If col = 8 Then lig = lig + 3: col = 1
    .Cells(lig, col) = j
    .Cells(lig - 1, col) = l
    .Cells(lig - 1, col).Interior.ColorIndex = 20
    Range(Cells(lig + 1, col), Cells(lig - 1, col)).Borders.LineStyle = xlDouble
    If m = j And k = n And an = o Then
    .Cells(lig, col).Interior.ColorIndex = 6
    End If
col = col + 1
Next
End With
End Sub

Pièce jointe 270869

Au plaisir

[patricktoulon]

Bonjour Nicolas
sincèrement une ligne de jour en format text c'est un peu tout mutch
il aurait été bien par exemple d'ajouter une colonne pour les numero de semaine
voir programmer un array pour les fériés
et je ne sais quoi d'autre qui pourrais avoir une fonction (utilité)
mais les jours pour chaque semaine non
allez tiens amuse toi avec ca

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
Sub test()
    create_calendrier 2017, 12    'année puis mois
End Sub
Function create_calendrier(année, mois)
    Dim i As Long, col As Long, lig As Long, nbjour As Long, difeuro As Long
    nbjour = Day(DateSerial(année, mois + 1, 0))    ' te donne le nombre de jour dans le mois en parametre
    col = Weekday(DateSerial(année, mois, 1))  ' te donne la colonne(l'index du jour de la semaine ), ajouter la différence si le calendrier ne commence pas en colonne "A"
    If Weekday(DateSerial(année, 1, 1), vbMonday) > 4 Then difeuro = 1    ' 1 si semaine commence apres jeudi
    If col = 1 Then col = 8
    lig = 3
    With Sheets(1)
        .Range(.Cells(1, 1), .Cells(14, 8)).ClearContents
        For i = 1 To nbjour
            If col = 9 Then lig = lig + 2: col = 2
            .Cells(lig, col) = i
            .Cells(lig, 1) = Val(Format(DateSerial(année, mois, i), "WW", vbMonday)) - difeuro
            col = col + 1
        Next
        .Cells(1, 2) = UCase(Format(DateSerial(année, mois, 1), "mmmm yyyy "))
        .Cells(2, 1).Resize(1, 8) = Array("semaine", "lundi", "mardi", "mercredi", "jeudi", "vendredi", "samedi", "dimanche")
 
            End With
End Function

UN PEU COMME CA

[Invité]

Bonjour,
Ce code concerne un userform mais le calcule de fériés est bien présent!
https://www.developpez.net/forums/d1...e/#post8029399

[patricktoulon]

salut robert nikel j'ai intégré ta fonction paque

Juste une petite question bête avant que je regarde, Comment tu fait pour combiner tes cellules K1 K2 avec ton code ?

@nicolas
dans l'evement change du sheet

Code :

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

1
2
3
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$K$2" Or Target.Address = "$K$1" Then create_calendrier Range("K1").Value, Range("K2").Value
End Sub

@docmarti
oui aussi

[Nicolas JACQUIN]

Merci à tous, y a du boulot là, merci encore

[patricktoulon]

si il y a avait pas de boulot on s'ennuierait
tu semble perdu avec l'évènement change ?

[Nicolas JACQUIN]

Non, ça c'est ok pas de soucis, mais c'est tout ce que vous m'avez balancé en peu de temps, je m'y perd

[Philippe Tulliez]

Bonjour,
Je ne voudrais pas gâcher la fête mais une simple mise en forme conditionnelle et quelques formules notamment de la catégorie Date et c'est fait.
Surtout si c'est pour faire un calendrier perpétuel. A quoi bon faire cela en VBA
Pour paraphraser Pierre Fauconnier "Penser Excel avant VBA"

[Invité]

Bonjour mes bien cher frères,
pour c'eux que ça intéresse (un informaticien c'est avant tout un documentaliste)!

http://asso-grecque-ahela.fr/docs/datepaques.pdf

https://fr.wikipedia.org/w/index.php...42n171pfgk536n

[patricktoulon]

Amen