Calendrier d'une année entière


Commenter

Contenu du snippet

Voila un script qui peut être très utile pour faire un calendrier.
Si vous avez un niveau suffisant, vous pourrez l'interfacer avec une base de données et en faire un vrai petit agenda :)
Mettez tout ce qui suit dans un page asp et ouvrez la page.

Source / Exemple : 


<%
' ************************************************************
' Code Réalisé par Nicolas SOREL ( Nix pour les intimes :) )
' Pour ASPFr.com
' Retrouvez d'autres scripts ASP sur www.ASPFr.com
' Vous avez le droit d'utiliser ce script dans vos pages mais si vous souhaitez
' l'exposer sur un autre site de programmation merci de me contacter 
' (contact@vbfrance.com)
' ************************************************************
Option Explicit

' ***************  La Config **************************
' Vous pouvez modifier l'aspect du calendrier en modifiant les variables si dessous
Dim Couleur (2), CouleurPolice(3),CouleurFond(2)
Dim Police(2), PoliceTaille(2), PoliceTailleJourJ
Dim BordureDansLaGrille, CoulBordureGrille
Dim NbMoisMaxParLigne

CouleurPolice(0) = "#FFFFFF"
CouleurPolice(1) = "#000000"
CouleurPolice(2) = "#000000"
CouleurPolice(3) = "#FF0000"

CouleurFond(0) = "#000000"
CouleurFond(1) = "#E0E0E0"
CouleurFond(2) = "#FF0000"

Police(0) = "Verdana"
Police(1) = "Arial"
Police(2) = "Arial"

PoliceTaille(0) = "2"
PoliceTaille(1) = "1"
PoliceTaille(2) = "1"

PoliceTailleJourJ = "2"

BordureDansLaGrille = False
CoulBordureGrille = "#000000"

NbMoisMaxParLigne = 4
' ***************  FIN Config **************************

Function NomMois(NumMois)
	Dim LesMois(12)
	LesMois(1) = "Janvier"
	LesMois(2) = "Février"
	LesMois(3) = "Mars"
	LesMois(4) = "Avril"
	LesMois(5) = "Mai"
	LesMois(6) = "Juin"
	LesMois(7) = "Juillet"
	LesMois(8) = "Août"
	LesMois(9) = "Septembre"
	LesMois(10) = "Octobre"
	LesMois(11) = "Novembre"
	LesMois(12) = "Décembre"
	NomMois = LesMois(NumMois)
End Function

Function LesJours()%>
		<td align="center" bgcolor="<%=CouleurFond(1)%>"><font face="<%=Police(1)%>" size="<%=PoliceTaille(1)%>" color="<%=CouleurPolice(1)%>">L</FONT><BR></TD>
		<td align="center" bgcolor="<%=CouleurFond(1)%>"><font face="<%=Police(1)%>" size="<%=PoliceTaille(1)%>" color="<%=CouleurPolice(1)%>">M</FONT><BR></TD>
		<td align="center" bgcolor="<%=CouleurFond(1)%>"><font face="<%=Police(1)%>" size="<%=PoliceTaille(1)%>" color="<%=CouleurPolice(1)%>">M</FONT><BR></td>
		<td align="center" bgcolor="<%=CouleurFond(1)%>"><font face="<%=Police(1)%>" size="<%=PoliceTaille(1)%>" color="<%=CouleurPolice(1)%>">J</FONT><BR></TD>
		<td align="center" bgcolor="<%=CouleurFond(1)%>"><font face="<%=Police(1)%>" size="<%=PoliceTaille(1)%>" color="<%=CouleurPolice(1)%>">V</FONT><BR></TD>
		<td align="center" bgcolor="<%=CouleurFond(1)%>"><font face="<%=Police(1)%>" size="<%=PoliceTaille(1)%>" color="<%=CouleurPolice(1)%>">S</FONT><BR></TD>
		<td align="center" bgcolor="<%=CouleurFond(1)%>"><font face="<%=Police(1)%>" size="<%=PoliceTaille(1)%>" color="<%=CouleurPolice(1)%>">D</FONT><BR></TD>
<%
End Function

Function LeMoisCommenceQuand(UnJourDuMois)
	Dim DateTmp
	DateTmp = DateAdd("d", -(Day(UnJourDuMois) - 1), UnJourDuMois)
	LeMoisCommenceQuand = WeekDay(DateTmp,vbMonDay)
End Function

Function MoisPrecedent(LaDate)
	MoisPrecedent = DateAdd("m", -1, LaDate)
End Function

Function MoisSuivant(LaDate)
	MoisSuivant = DateAdd("m", 1, LaDate)
End Function

Function NbJourDansLeMois(LeMois, LeAnnee)
	Dim DateTmp
	DateTmp = DateAdd("d", -1, DateSerial(LeAnnee, LeMois + 1, 1))
	NbJourDansLeMois = Day(DateTmp)
End Function

Function ConvInt(Chiffre)
	Dim NouvChiffre
		NouvChiffre = Chiffre
	if Cint(NouvChiffre) < 10 then
		NouvChiffre = "0" & NouvChiffre
	end if
	ConvInt = NouvChiffre
End Function

Function CalendrierMois(LaDate)
Dim LaDateBis
Dim PremierJour
Dim NbJourMois
Dim JourEnCours
Dim LaPosition

If IsDate(LaDate) Then
	LaDateBis = CDate(LaDate)
Else
	LaDateBis = Date()
End If

PremierJour = NbJourDansLeMois(Month(LaDateBis), Year(LaDateBis))
NbJourMois = LeMoisCommenceQuand(LaDateBis)
%>
<table border="1" cellspacing="0" cellpadding="0" bordercolor="#000000">
	<TR>
		<TD>
			<table width="100%" border="<%If BordureDansLaGrille = True Then%>1" bordercolor="<%=CoulBordureGrille%><%Else%>0<%End If%>" cellspacing="0" cellpadding="4">
				<TR>
					<td colspan="7" align="center" bgcolor="#000000">
						<table width="100%" border="0" cellspacing="0" cellpadding="0">
							<TR>
								<td align="left" bgcolor="<%=CouleurFond(0)%>"><font face="<%=Police(0)%>" size="<%=PoliceTaille(0)%>" color="<%=CouleurPolice(0)%>"><B><%=NomMois(Month(LaDateBis))%></B></FONT></td>
								<td align="right" bgcolor="<%=CouleurFond(0)%>"><font face="<%=Police(0)%>" size="<%=PoliceTaille(0)%>" color="<%=CouleurPolice(0)%>"><B><%=Year(LaDateBis)%></B></FONT></td>
							</TR>
						</TABLE>
					</td>
				</TR>
				<TR>
					<%Call LesJours()%>
				</TR>
<%
If NbJourMois <> 1 Then
	Response.Write vbTab & "<TR>" & vbCrLf
	LaPosition = 1
	Do While LaPosition < NbJourMois
		Response.Write vbTab & vbTab & "<TD><FONT face =""" & Police(2) & """ SIZE=""" & PoliceTaille(2) & """ color=""" & CouleurPolice(2) & """>&nbsp;</font></TD>" & vbCrLf
		LaPosition = LaPosition + 1
	Loop
End If

JourEnCours = 1
LaPosition = NbJourMois
Do While JourEnCours <= PremierJour
	If LaPosition = 1 Then
		Response.Write vbTab & "<TR>" & vbCrLf
	End If
	If Date() = CDate(ConvInt(JourEnCours) & "/" & ConvInt(Month(LaDateBis)) & "/" &  Right(Year(LaDateBis),2)) Then
		Response.Write vbTab & vbTab & "<TD align=""center""><FONT face =""" & Police(2) & """ SIZE=""" & PoliceTailleJourJ & """ color=""" & CouleurPolice(3) & """><b>" & JourEnCours & "</b></FONT></TD>" & vbCrLf
	Else
		Response.Write vbTab & vbTab & "<TD align=""center""><FONT face =""" & Police(2) & """ SIZE=""" & PoliceTaille(2) & """ color=""" & CouleurPolice(2) & """>" & JourEnCours & "</FONT></TD>" & vbCrLf
	End If
	If LaPosition = 7 Then
		Response.Write vbTab & "</TR>" & vbCrLf
		LaPosition = 0
	End If
	JourEnCours = JourEnCours + 1
	LaPosition = LaPosition + 1
Loop
If LaPosition <> 1 Then
	Do While LaPosition <= 7
		Response.Write vbTab & vbTab & "<TD><FONT face =""" & Police(2) & """ SIZE=""" & PoliceTaille(2) & """ color=""" & CouleurPolice(2) & """>&nbsp;</font></TD>" & vbCrLf
		LaPosition = LaPosition + 1
	Loop
	Response.Write vbTab & "</TR>" & vbCrLf
End If
%>
			</TABLE>
		</TD>
	</TR>
</TABLE>
<%End Function%>

<html>
<head>
	<title>Calendrier Par Nix</title>
</head>
<body bgcolor="#FFFFFF" text="#000000" link="#0000FF" vlink="#0000FF" alink="#FF0000">
<table border="0" cellspacing="0" cellpadding="5" bordercolor="#000000">
	<tr><td colspan="<%=NbMoisMaxParLigne%>"><div align="center"><font face="Arial" size="4" color="#0000FF">Calendrier de l'année <%=Year(Date())%></font></div></td></tr>
	<tr>
<%
	Dim ComptCol, i
	ComptCol = 1

For i = 1 To 12%>
		<td align="center" valign="top"><%Call CalendrierMois(Cdate("01/" & ConvInt(i) & "/" & Right(Year(Date()),2)))%></td>
		<%If ComptCol = NbMoisMaxParLigne Then%><%ComptCol = 0%></tr><tr><%End If
		ComptCol = ComptCol + 1
Next%>
	</tr>
</table>
</body>
</html>

Conclusion :


Avec ça, vous ferez concurence à votre facteur :) Reste plus qu'à metrte la photo d'un petit chien en haut :)

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.

Du même auteur (Nix)