<% Function DiasNoMes(iMonth, iYear) Dim dTemp dTemp = DateAdd("d", -1, DateSerial(iYear, iMonth + 1, 1)) DiasNoMes = Day(dTemp) End Function Function DiaDaSemanaQueComecaOMes(dAnyDayInTheMonth) Dim dTemp dTemp = DateAdd("d", -(Day(dAnyDayInTheMonth) - 1), dAnyDayInTheMonth) 'Semana comecando na segunda. Para comecar domingo tirar o ",2" DiaDaSemanaQueComecaOMes = WeekDay(dTemp,2) End Function Function DiminuiUmMes(dData) DiminuiUmMes = DateAdd("m", -1, dData) End Function Function SomaUmMes(dData) SomaUmMes = DateAdd("m", 1, dData) End Function Function NomeMes(iMes) dim vMes(12) vMes(1) = "janeiro" vMes(2) = "fevereiro" vMes(3) = "março" vMes(4) = "abril" vMes(5) = "maio" vMes(6) = "junho" vMes(7) = "julho" vMes(8) = "agosto" vMes(9) = "setembro" vMes(10) = "outubro" vMes(11) = "novembro" vMes(12) = "dezembro" NomeMes = vMes(iMes) End Function Dim dData ' Data escolhida Dim iDiasMes ' Numero de dias do mês Dim iDiaSemana ' Dia da semana que começa o mês Dim iDiaAtual ' Dia corrente do mês Dim iPosicao ' Posição atual da tabela Dim DataMinima ' Menor data para mostar o calendário If IsDate(Request.QueryString("data")) Then dData = CDate(Request.QueryString("data")) Else If IsDate(Request.QueryString("d") & "/" & Request.QueryString("m") & "/" & Request.QueryString("a")) Then dData = CDate(Request.QueryString("d") & "/" & Request.QueryString("m") & "/" & Request.QueryString("a")) Else dData = Date() End If End If iDiasMes = DiasNoMes(Month(dData), Year(dData)) iDiaSemana = DiaDaSemanaQueComecaOMes(dData) 'Data máxima para mostrar link no calendário 'DataMaxima = Date() + 56 'DataMaxima = CDate("01/07/2012") DataMaxima = DateAdd("m",3,Date()) - Day(Date()) DataMinima = CDate("01/08/2012") %>

<%= NomeMes(Month(dData)) & " " & Year(dData) %>

S T Q Q S S D

<% ' Escreve espaços nas celulas da primeira linha se o mês não começa na segunda If iDiaSemana <> 1 Then Response.Write vbTab & "" & vbCrLf iPosicao = 1 Do While iPosicao < iDiaSemana Response.Write vbTab & vbTab & "" & vbCrLf iPosicao = iPosicao + 1 Loop End If ' Escreve os dias do mês nos lugares apropriados iDiaAtual = 1 iPosicao = iDiaSemana Do While iDiaAtual <= iDiasMes ' Data da celula corrente dDataCelula = dData - Day(dData) + iDiaAtual ' Começo da linha If iPosicao = 1 Then Response.Write vbTab & "" & vbCrLf End If ' Coloca o dia corrente em destaque 'If iDiaAtual = Day(dData) and Month(dData) = Month(date()) and Year(dData) = Year(Date()) Then If dDataCelula = Date() Then a = "" & iDiaAtual & "" td = "" Response.Write vbTab & vbTab & td & vbCrLf ' Apenas o dia anterior até a data máxima definida deve ter link ' ElseIf (dDataCelula >= Date() - 1) and (dDataCelula <= DataMaxima) Then ElseIf (dDataCelula >= DataMinima) Then a = "" & iDiaAtual & "" td = "" Response.Write vbTab & vbTab & td & vbCrLf 'Response.Write vbTab & vbTab & "" & vbCrLf ' Os demais dias não devem ter link Else Response.Write vbTab & vbTab & "" & vbCrLf End If ' Fim da linha If iPosicao = 7 Then Response.Write vbTab & "" & vbCrLf iPosicao = 0 End If iDiaAtual = iDiaAtual + 1 iPosicao = iPosicao + 1 Loop ' Escreve espaços nas celulas da ultima linha se o mês não termina no domingo If iPosicao <> 1 Then Do While iPosicao <= 7 Response.Write vbTab & vbTab & "" & vbCrLf iPosicao = iPosicao + 1 Loop Response.Write vbTab & "" & vbCrLf End If %>   " & a & " " & a & " " & iDiaAtual & " " & iDiaAtual & "