Calendrier annuel

Télécharger le projet
Commenter

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.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.