Calendrier annuel

Soyez le premier à donner votre avis sur cette source.

Vue 16 237 fois - Téléchargée 1 144 fois

Description

Ce calendrier présente un semestre après l'autre avec le nom des saints et fêtes religieuses et jours fériés. Ce code a été écrit sous VB6.

Source / Exemple :


Dim yr As Integer

Sub calmensuel(obj As PictureBox, mois As Long, nyear As Integer)
Dim I As Integer, date1 As Date

obj.Cls
With obj
   .AutoRedraw = True
   .BorderStyle = 0
   .FontSize = 8
'   .FontName = "Garamond"
   .Height = 6045
   .ScaleMode = 3
   .Width = 1695
End With

obj.ForeColor = RGB(255, 0, 0)
date1 = DateSerial(nyear, mois, 1)
obj.Print Tab(1); Format(date1, "mmmm"); Spc(1); nyear & Chr(13);
obj.Print Space(1); " ";

For I = 1 To findemois(mois, nyear)
    date1 = DateSerial(nyear, mois, I)
        
If Weekday(JoursFériés(date1, nyear)) = Weekday(date1) Then
obj.ForeColor = RGB(255, 0, 0)
obj.FontBold = False
ElseIf Weekday(AutresFetes(date1, nyear)) = Weekday(date1) Then
obj.ForeColor = RGB(255, 0, 0)
obj.FontBold = False
ElseIf Fêtes_Religieuses(date1, nyear) = True Then
obj.ForeColor = RGB(255, 0, 0)
obj.FontBold = False
ElseIf Weekday(date1) = vbSaturday Or Weekday(date1) = vbSunday Then
obj.ForeColor = RGB(255, 0, 0)
obj.FontBold = False
Else
    If Day(Now) = I And mois = Month(Now) And nyear = Year(Now) Then
'    obj.FontBold = True
    obj.ForeColor = RGB(0, 255, 255)
    Else
'    obj.FontBold = False
    obj.ForeColor = RGB(0, 0, 0)
    End If
End If
        
obj.Print Tab(1); LeftRight(Format(date1, "ddd"), 0); Tab(5); Format(date1, "dd"); Spc(1); lafete(date1, nyear)
Next I
End Sub
Function findemois(mois As Long, annee As Integer) As Integer
'cette Function determine le nombre de jours dans un mois
On Error GoTo Error_findemois

findemois = _
DateSerial(annee, mois + 1, 1) - DateSerial(annee, mois, 1)
    
Exit_findemois:
    Exit Function
    
Error_findemois:
    MsgBox Err.Number & " " & Err.Description
    Resume Exit_findemois
End Function

Private Sub Command1_Click()
'pour afficher le 2ème semestre
Picture3(0).Visible = False
With Picture3(1)
.Visible = True
.Top = 285
.Left = 195
End With
End Sub

Private Sub Command2_Click()
'pour afficher le 1er semestre
Picture3(1).Visible = False
With Picture3(0)
.Visible = True
.Top = 285
.Left = 195
End With
End Sub

Private Sub Command3_Click(Index As Integer)
Select Case Index
Case 0
yr = yr - 1
If yr < 1 Then yr = 1
Refresh
Case 1
yr = yr + 1
Refresh
Case 2
yr = Year(Now)
Command3(2).Caption = yr
Refresh
End Select
End Sub

Private Sub Form_Load()
Dim dat2 As Date

yr = Year(Date)
dat2 = DateSerial(yr, Month(Now), Day(Now))
Me.Caption = "Calendrier annuel - " & lafete(dat2, yr) & " le " & dat2
End Sub

Private Sub Form_Paint()
'pour afficher les mois du calendrier
For I = 1 To 12
Pic(I).BorderStyle = 0
calmensuel Pic(I), CLng(I), yr
Next I
Label1.Caption = "An " & yr

'pour afficher le semestre en cours
If Format(Date, "mm") < 7 Then
Picture3(0).Visible = True
Picture3(1).Visible = False
Else
Picture3(1).Visible = True
Picture3(0).Visible = False
End If

'pour activer/désactiver les boutons
'des semestres
If Picture3(1).Visible Then
Command1.Enabled = False
Command2.Enabled = True
End If
If Picture3(0).Visible Then
Command2.Enabled = False
Command1.Enabled = True
End If
End Sub

Private Sub Form_Resize()
yr = Year(Now)
Command3(2).Caption = yr
End Sub

Conclusion :


Légère modification du code avec commentaires + ajout de polices.

Je remercie Lucky2222 qui, grâce à son travail, m'a permis de faire celui-ci qui est sans prétention aucune.

Pas de bugs connus.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
10
Date d'inscription
mardi 5 janvier 2010
Statut
Membre
Dernière intervention
17 novembre 2011

Impressionnant 10/10

Patrice
Messages postés
38
Date d'inscription
lundi 18 mars 2002
Statut
Membre
Dernière intervention
29 octobre 2003

Exact, le concordat nous accorde deux jours fériés de plus :
- le Vendredi Saint (vendredi juste avant le dimanche de paques)
- la St Etienne (26 décembre)
voila :)

A+
Messages postés
7
Date d'inscription
jeudi 6 février 2003
Statut
Membre
Dernière intervention
29 septembre 2007

Salut rnosat et orisa

Pour rnosat
J'ai ajouté des commentaires. Je ne crois pas que cela soit ardu mais je m'y penché dès ce soir.

Pour orisa
Je note. Auriez-vous (Alsaciens et Mosellans) d'autres jours fériés ?

A bientôt.

Nanette
Messages postés
38
Date d'inscription
lundi 18 mars 2002
Statut
Membre
Dernière intervention
29 octobre 2003

Vraiment très très bien !
par contre tu pourrait ne pas oublier les alsacien et mosellant : chez nous le vendredi saint et la st éthienne sont fériés !
une chtite case à cocher pour nous stp :)
Messages postés
132
Date d'inscription
mardi 31 octobre 2000
Statut
Membre
Dernière intervention
2 mai 2004

Salut Nanette !
J'apprécie ton calendrier annuel ( meme si je débute, je n'ai pas tout saisi le code en entier... ) , j'ai une remarque :
ne pourrais tu pas faire en sorte qu'on puisse cliquer sur une date ( comme un boutton command ) , et qu'on puisse en extraire la date seclectionnée ? On pourrait alors utiliser ton calendrier pour selectionnner des dates + facilement.
Qu'en penses tu ? est ce dur a faire ?

A +

Rnosat
Afficher les 7 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.