Jump to content
FabianoSouza

[Resolvido] Calendário somente com dias úteis

Recommended Posts

Encontrei esse código para gerar um calendário (funciona).

Mas quero "configurar" para exibir apenas os dias úteis.

Anexei um print para ilustrar o problema.

 

Agradeço desde já.

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%Option Explicit%>
<%
Session.LCID=1046
%>

<%
Function FormatStr(String)
	on Error resume next
	String = Replace(String, CHR(13), "")
	String = Replace(String, CHR(10) & CHR(10), "</P><P>")
	String = Replace(String, CHR(10), "<BR>")
	FormatStr = String
End Function

Dim dtToday 
dtToday = Date()

Dim dtCurViewMonth ' First day of the currently viewed month
Dim dtCurViewDay ' Current day of the currently viewed month
Dim frmDate ' Date submitted by form

' if the GO button was used, build the date from the month and year

If InStr(1, Request.Form, "subGO", 1) > 0  then
	if Request.Form("CURDATE_month") = "" then
		tmpMonth = month(now())
	else
		tmpMonth = Request.Form("CURDATE_month")
	End If
	
	if Request.Form("CURDATE_year") = "" then
		tmpyear = year(now())
	else
		tmpyear = Request.Form("CURDATE_year")
	End If
		
	tmpDate = "1 " & tmpMonth & " 1999"
	
	mnth = Month(tmpDate)
	frmDate = DateSerial(tmpyear, mnth, 1)
Else

	frmDate = Request.Form("CURDATE")
	
end if

if Request("view_date") <> "" then 
	frmDate= DateSerial(year(Request("view_date")), month(Request("view_date")), 1)
end if

%>

<% 
'--------------------------------------------------
   Function DtPrevSunday(ByVal dt)
      Do While WeekDay(dt) > vbMOnday
         dt = DateAdd("d", -1, dt) 
      Loop
   DtPrevSunday = dt
   End Function
'--------------------------------------------------
%>

<%REM Set current view month from posted CURDATE,  or
' the current date as appropriate.

' if posted from the form
' if prev button was hit on the form
   If InStr(1, Request.Form, "subPrev", 1) > 0 Then
      dtCurViewMonth = DateAdd("m", -1, frmDate)
' if next button was hit on the form
   ElseIf InStr(1, Request.Form, "subNext", 1) > 0 Then
      dtCurViewMonth = DateAdd("m", 1, frmDate)
' anyother time
      Else

' date add in text box
         If InStr(1, Request.Form, "subGO", 1) > 0 then
			dtCurViewMonth = frmDate
		 Else
			if Request("view_date") <> "" then 
				dtCurviewMonth = frmDate
			else
            dtCurViewMonth = DateSerial(Year(dtToday), Month(dtToday), 1)
            End If
         End If
   End If
%>

<% REM --------BEGINNING OF DRAW CALENDAR SECTION-------- %>
<% REM This section executes the event query and draws a matching calendar. %>
<%
   Dim iDay, iWeek, sFontColor, dictDte(31,2), intCount
   strSql = "SELECT * FROM DATAS WHERE month(DatasDataInicio)= " & month(dtCurViewMonth) & " and year(DatasDataInicio) = " & year(dtCurViewMonth) & ""
   
   set rs = conn.Execute (StrSql)
   
   intCount= 0
   
   ' populate array with days of month
   on Error resume next
   
  
   do until rs.EOF
  
   if intCount > 31 then exit do
   if Day(rs("DatasDataInicio")) = intCount + 1 then 
		dictDte(intCount, 1) = left(rs("DatasDescricao"),15)&"..."
		rs.Movenext
	Else 
		dictDte(intCount, 1) = " "
	End If
	dictDte(intCount, 2) = intCount + 1
	intCount = intCount + 1
   loop
  
%>          <table width="100%" border="0" cellspacing="0" cellpadding="2">
            <tr>
              <td colspan="2">

<table width="100%" border="0" align="center" cellpadding="3" cellspacing="0">
                <tr align="center" height="25" valign="middle">
                  <% For iDay = vbMonday To vbFriday %>
                  <th width="14%" align="left"><%=WeekDayName(iDay)%></th>
                  <%Next %>
                  </tr>
                <%
   dtCurViewDay = DtPrevSunday(dtCurViewMonth)
  
   For iWeek = 0 To 6
      Response.Write "<TR VALIGN=TOP>" & vbCrLf

Dim sBGCOLOR 
sBGCOLOR = "#FFFFFF"


For iDay = 0 To 6
sBGCOLOR = "#FFFFFF"
If Month(dtCurViewDay) = Month(dtCurViewMonth) Then

'Marca dia atual 
If dtCurViewDay = dtToday Then sBGCOLOR = "#EFB4CF"
else 
 sBGCOLOR = "#F5F5F5"
 
End If
Response.Write "<TD HEIGHT=75 bgcolor='" & sBGCOLOR & "' align=left class=gridCal >"
 
   If Month(dtCurViewDay) = Month(dtCurViewMonth) Then
		If dtCurViewDay = dtToday Then
               sFontColor = "#ff0000"

            Else
               sFontColor = "#00000"
            End If
      
         '---- Write day of month
            
            Response.Write "<a href=rhCalendarioDetalhes.asp?" & "view_date=" & day(dtCurViewday) & "-" & monthname(month(dtCurViewday)) & "-" & year(dtCurViewday) & " span class=data>"  & Day(dtCurViewDay) & "</a><span class=txt3>"& formatStr(dictDte(Day(dtCurViewDay)- 1, 1)) & "</span>"
         '---Else
            '---Response.Write " "
         End If

         Response.Write "</TD>" & vbCrLf
         dtCurViewDay = DateAdd("d", 1, dtCurViewDay)
      Next
      Response.Write "</TR>" & vbCrLf
   Next
%>

  </table>
</td>
</tr>
</table>

 

forum.PNG

Share this post


Link to post
Share on other sites

Você tem que criar um cadastro de feriados e fazer a leitura deles no momento em que montar o calendário.

Share this post


Link to post
Share on other sites

Olá hargon.

No meu caso é para exibir apenas a semana em formato de cinco dias (segunda à sexta-feira), não para verificar feriados. Mas de todo modo sua informação será útil para outras finalidades do meu sistema.

Valew!

Share this post


Link to post
Share on other sites
For iWeek = 0 To 6
For iDay = 0 To 6

 

não parei para analisar o código por inteiro as esse 2 loops definem os nomes dos dias e o outro define o numero do dia 

onde começa com 0 a segunda feira até 6 domingo então para testar coloque os loop até 4 ao invés de 6

  • +1 1

Share this post


Link to post
Share on other sites

você pode ter a cadstro de feriado e depois usar uma classe CSS para exibi-lo diferente ou também usar jquery para ocultar somente o que deseja

 

  • +1 1

Share this post


Link to post
Share on other sites
Em 05/05/2017 at 08:46, Gustavo Emygdio Barboza disse:

For iWeek = 0 To 6
For iDay = 0 To 6

 

não parei para analisar o código por inteiro as esse 2 loops definem os nomes dos dias e o outro define o numero do dia 

onde começa com 0 a segunda feira até 6 domingo então para testar coloque os loop até 4 ao invés de 6

 

Blz!! Era nos loops.

             <% For iDay = vbSunday To vbSaturday%>
              <th width="14%" class="fundoBarraSemanas"><span class="tituloDia"><%=WeekDayName(iDay)%></span></th>
              <%Next %>

E nos outros...

   For iWeek = 0 To 6
      Response.Write "<TR VALIGN=TOP>" & vbCrLf

Dim sBGCOLOR 
sBGCOLOR = "#FFFFFF"


For iDay = 0 To 6
sBGCOLOR = "#FFFFFF"
If Month(dtCurViewDay) = Month(dtCurViewMonth) Then
...

Agora compreendi a lógica disso.

É possível definir se a semana começa na segunda, se vai de domingo à sábado e várias outras "configurações".

 

Aí se esconde os finais de semana com CSS, por exemplo.

 

Valew, fera!!!!

Edited by FabianoSouza

Share this post


Link to post
Share on other sites

Valew galera. Problema resolvido.

Ajustei os três loops (nome dos dias da semana, quantidade de semanas e dos dias do mês) e tudo se resolveu.

 

Depois só usar CSS para esconder o sábado e o domingo (como os colegas sugeriram) e bingo!

 

Moderador, passa a régua no tópico.

 

Valew!

calendario.png

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×

Important Information

Ao usar o fórum, você concorda com nossos Terms of Use.