[Resolvido]Alteração em calendário em relatório...

Gente bom dia!!! Eu tentei, estudei tentei alterar as fontes mas não consegui o que exatamente eu quero... Na verdade o Lupe passou um link http://maximoaccess.forumeiros.com/download.forum?id=5060 para o ótimo trabalho que foi esse calendário em relatório, só que eu tenho um relatório com várias anotações e queria que ao invés de colocar o circulo em apenas uma data eu queria que fosse só um calendário e nesse fosse colocado todos os círculos conforme a imagem abaixo:




Tem como??? Gente desde ja agradeço muito a atenção de vcs.. Xerooooo

Boa tarde, Maria José
Disponibilize a bd para se trabalhar

Oi Alexandre... Brigadão pelo atendimento... Conforme solicitado segue em anexo o arquivo... Bjs e boa tarde

http://speedy.sh/h9MJP/Agenda-2.accdb

Com a permissão do Grande Alexandre;

Hoje de tarde fiz algo assim;

Option Compare Database
Option Explicit

Private Rst As DAO.Recordset, bytNr As Byte

Private Sub CabeçalhoDoGrupo0_Format(Cancel As Integer, FormatCount As Integer)
Set Rst = CurrentDb.OpenRecordset("SELECT DISTINCT Format(Data,'d') FROM Cons_agenda WHERE Format(Data,'mm-yyyy')='" & Format(Data, "mm-yyyy") & "' ORDER BY Format(Data,'d')")
Do While Not Rst.EOF
Call MarcaDia(Rst(0))
Rst.MoveNext
Loop
End Sub

Private Sub Detalhe_Format(Cancel As Integer, FormatCount As Integer)
Call ShowCal
End Sub

Private Function ShowCal() As Boolean

'Purpose:
Dim dtStartDate As Date 'First of month
Dim iDays As Integer 'Days in month
Dim iOffset As Integer 'Offset to first label for month.
Dim i As Integer 'Loop controller.
Dim iDay As Integer 'Day under consideration.
Dim bshow As Boolean 'Flag: show label

dtStartDate = Me.txtDate - Day(Me.txtDate) + 1 'First of month
iDays = Day(DateAdd("m", 1, dtStartDate) - 1) 'Days in month.
iOffset = Weekday(dtStartDate, vbSunday) - 2 'Offset to first label for month.

For i = 0 To 41
With Me("lblDay" & Format(i, "00"))
iDay = i - iOffset
bshow = ((iDay > 0) And (iDay <= iDays))
If .Visible <> bshow Then
.Visible = bshow
End If
If (bshow) And (.Caption <> iDay) Then
.Caption = iDay
End If
End With
Next

End Function

Private Function SetSelected(ctlName As String)

Me.txtDate = DateSerial(Year(txtDate), Month(txtDate), CLng(Me(ctlName).Caption))
Call ShowHighligher(ctlName)

End Function

Private Function SetDate(Unit As String, Optional intStep As Integer = 1)

Me.txtDate = DateAdd(Unit, intStep, Me.txtDate)
Call ShowCal

End Function
Private Function SelectDate(ctlName As String)
Call SetSelected(ctlName)

End Function

Private Sub Report_Close()
Set Rst = Nothing
End Sub

Sub MarcaDia(bytDia As Byte)
For bytNr = 0 To 41
If Me("lblDay" & Format(bytNr, "00")).Caption = bytDia Then
Circle (Me("lblDay" & Format(bytNr, "00")).Left + Me("lblDay" & Format(bytNr, "00")).Width / 2, Me("lblDay" & Format(bytNr, "00")).Top + Me("lblDay" & Format(bytNr, "00")).Height / 2), 150, RGB(250, 0, 0), , , 0.8
End If
Next
End Sub

Beijos,

Opa Mestre,
Fomos juntos. Abraço,

Olá JPaulo quanto tempo né... rsrsrsrsr Muito obrigado querido, vou estudar direitinho a sua opção ok?!? Alexandre meu amor, muito obrigado tah?!? Valeu pelo apoio dos dois...

Grande Beijão...

Grande Alexandre ficou perfeita a sua adaptação, nota 10.
Maria, muito gosto em tê-la por cá sempre que precisar.

Obrigado pelo retorno.