Hi Andreret,
As per the dicussion today on my previous thread, i am creating a new thread for the function to convert the numbers on the grid to a date. I am waiting for your code. Kindly share once you done tomorrow or the day next
divakar.it 4 Junior Poster in Training
AndreRet 526 Senior Poster
No problem. I'll post it today.:)
AndreRet 526 Senior Poster
This is what I have so far. Time is not on my side to finish this, your turn now.:)
It will get a start date, end date and then get the balance between the dates. It will then load the start date and turn thew background red. It will then load the days after that. I have only managed to get it to load one row. We need to get it to load the second and so on. Have a look at the last part of the code for this.
We also still need to get it to load correctly with the remainder of the days when the next month is selected. Then we need to disable all so the user can not play around with the calender. Let me know if you could get any further. I'll try and squeeze some more time on this;)
Dim xStart As Date, yEnd As Date, zDays As Integer, qDay As String, strGrid As String, dDay As String
Dim t As Integer, g As Integer
xStart = "2010/10/20"
yEnd = "2010/11/20"
qDay = Day(xStart)
zDays = (yEnd - xStart) - 2 'For the start date and end date - 2 days...
dDay = qDay
'Load the grid with the begin date...
lstMonth.ListIndex = Month(xStart) - 1
lstYear.Text = Year(xStart)
Dim rRow As Integer, cCol As Integer
'These will get and "hold" the values of the start day
Dim xRow As Integer, xCol As Integer
'Find the day to start from...
For rRow = 0 To CalGrid.Rows - 1
For cCol = 0 To CalGrid.Cols - 1
strGrid = Format(CalGrid.TextMatrix(rRow, cCol), "##")
strGrid = Trim(strGrid)
If dDay = Mid(strGrid, 1, Len(strGrid)) Then
CalGrid.Row = rRow
xRow = rRow
CalGrid.Col = cCol
xCol = cCol
CalGrid.CellBackColor = vbRed
Exit For
Exit For
End If
Next cCol
Next rRow
'Now load every other day with the balance of the days....
Dim xBalance As Integer
Dim lngRow As Long
Dim lngCol As Long
lngRow = xRow
lngCol = xCol
'First put an if then in here because an error will be raised when the end of a coloumn is reached...
'We know that there are 6 rows and 7 coloumns to work with, so....
With CalGrid
For xBalance = 0 To zDays '28 days in this case, remember the 2 days deducted previously!
If xCol + 1 > .Cols - 1 Then
xCol = .FixedCols
xCol = .Col + 1 'xCol + 1
xRow = .Row + 1 'xRow + 1
Else
.Col = xCol + 1
.CellBackColor = vbRed
xCol = xCol + 1
End If
Next xBalance
End With divakar.it 4 Junior Poster in Training
Thank Guruji (Guruji means teacher). Will have a try and let u know incase of any issues
AndreRet 526 Senior Poster
"Guruji" - :cool: Thanks...
As I have mentioned, I'll try and put some more time into this. It might be something my guys can use as well when using vb6.:)
AndreRet 526 Senior Poster
Ok, here is the revised code that will load all dates to the end of the month on display. To follow soon is the following months colour change. I'll post that later...
Private Sub Command1_Click()
Dim xStart As Date, yEnd As Date, zDays As Integer, qDay As String, strGrid As String, dDay As String
Dim t As Integer, g As Integer
xStart = "2010/10/09"
yEnd = "2010/12/09"
qDay = Day(xStart)
zDays = (yEnd - xStart) - 1 'Deduct the start date. Will load background to end date...
'zDays = Format(zDays, "dd")
dDay = qDay
'Load the grid with the begin date...
lstMonth.ListIndex = Month(xStart) - 1
lstYear.Text = Year(xStart)
Dim rRow As Integer, cCol As Integer
'These will get and "hold" the values of the start day
Dim xRow As Integer, xCol As Integer
'Find the day to start from...
For rRow = 0 To CalGrid.Rows - 1
For cCol = 0 To CalGrid.Cols - 1
strGrid = Format(CalGrid.TextMatrix(rRow, cCol), "##")
strGrid = Trim(strGrid)
If dDay = Mid(strGrid, 1, Len(strGrid)) Then
CalGrid.Row = rRow
xRow = rRow
CalGrid.Col = cCol
xCol = cCol
CalGrid.CellBackColor = vbRed
Exit For
Exit For
End If
Next cCol
Next rRow
'Now load every other day with the balance of the days....
Dim xBalance As Integer
Dim lngRow As Long
Dim lngCol As Long
lngRow = xRow
lngCol = xCol
'First put an if then in here because an error will be raised when the end of a coloumn is reached...
'We know that there are 6 rows and 7 coloumns to work with, so....
With CalGrid
For xBalance = 0 To zDays '28 days in this case, remember the 2 days deducted previously!
If xCol + 1 > .Cols - 1 Then
xRow = xRow + 1
.Row = xRow
xCol = 0 'Set back to zero to start recounting
.Col = 0
.CellBackColor = vbRed
ElseIf xRow + 1 > .Rows - 1 Then
Exit For
Else
.Col = xCol + 1
.CellBackColor = vbRed
xCol = xCol + 1
End If
Next xBalance
End With
End Sub divakar.it 4 Junior Poster in Training
Thanks Guruji. The only problem i am facing after include this code (I included in Form_Paint Subroutine) is, when i select the any month its still showing October only however if i use F8 to run step by step its working. Dont know whether i put the code in wrong sub routine
AndreRet 526 Senior Poster
I have tested the code under a command button click event and it worked fine.
I have managed to do a bit more in the mean while. Still not 100%, it reads the second months date and change the backcolour from there on if it overlaps. Enjoy the code to this end...;)
'I have added a second sub to enlarge the grid when there is more than one month...
Private Sub TwoMonthCalender()
Dim BanyakTanggal As Integer
Dim TahunTampil As Integer
Dim CekKabisat As Boolean
Dim HariPertama As Integer
Dim BulanTampil As Integer
Dim a As Long
Dim b As Long
Dim i As Integer
Dim z As Integer
Dim TanggalSekarang As Date
TanggalSekarang = Now
TanggalSekarang = Day(TanggalSekarang)
For a = 1 To 9
For b = 0 To 6
CalGrid.Row = a
CalGrid.Col = b
CalGrid.Clear
Next b
Next a
Grid_Kalender_Load
BulanTampil = lstMonth.ListIndex + 1
TahunTampil = lstYear.ListIndex + MinTahun
HariPertama = Program_HariPertama(BulanTampil, TahunTampil)
CekKabisat = Program_CekKabisat(TahunTampil)
If BulanTampil = 4 Or BulanTampil = 6 Or BulanTampil = 9 Or BulanTampil = 11 Then
BanyakTanggal = 30
ElseIf (BulanTampil = 2 And CekKabisat = True) Then
BanyakTanggal = 29
ElseIf (BulanTampil = 2 And CekKabisat = False) Then
BanyakTanggal = 28
Else
BanyakTanggal = 31
End If
Dim HariPertamaJawa As Integer
Dim HariJawa As Integer
Dim TahunTampil_temp As Integer
If (TahunTampil > 2000) Then
TahunTampil_temp = TahunTampil - 100
Else
TahunTampil_temp = TahunTampil
End If
If (CekKabisat = True) Then
HariPertamaJawa = Program_HariJawaKabisat(BulanTampil, TahunTampil_temp)
Else
HariPertamaJawa = Program_HariJawaBiasa(BulanTampil, TahunTampil_temp)
End If
HariJawa = HariPertamaJawa
a = 1
z = 1
b = HariPertama - 1
For i = 1 To BanyakTanggal
CalGrid.Row = a
CalGrid.Col = b
CalGrid.CellAlignment = 4
CalGrid.WordWrap = True
If (HariIni = True And i = TanggalSekarang) Then
CalGrid.CellBackColor = &HE0E0E0
TextTanggalSekarang = GetNamaHari(b + 1) & " " & NamaJawa(HariJawa) & "," & i & " " & lstMonth.List(lstMonth.ListIndex) & " " & TahunTampil
End If
CalGrid.Text = i & vbNewLine & NamaJawa(HariJawa)
If (HariJawa = 5) Then
HariJawa = 1
Else
HariJawa = HariJawa + 1
End If
If (b = 6) Then
a = a + 1
b = -1
End If
b = b + 1
Next i
For z = 1 To BanyakTanggal
CalGrid.Row = a
CalGrid.Col = b
CalGrid.CellAlignment = 4
CalGrid.WordWrap = True
If (HariIni = True And z = TanggalSekarang) Then
CalGrid.CellBackColor = &HE0E0E0
TextTanggalSekarang = GetNamaHari(b + 1) & " " & NamaJawa(HariJawa) & "," & z & " " & lstMonth.List(lstMonth.ListIndex) & " " & TahunTampil
End If
CalGrid.Text = z & vbNewLine & NamaJawa(HariJawa)
If (HariJawa = 5) Then
HariJawa = 1
Else
HariJawa = HariJawa + 1
End If
If (b = 6) Then
a = a + 1
b = -1
End If
b = b + 1
Next z
HariIni = False
End Sub
Private Sub Command1_Click()
Dim xStart As Date, yEnd As Date, zDays As Integer, qDay As String, strGrid As String, dDay As String
Dim xMonthStart As String, yMonthEnd As String
Dim rRow As Integer, cCol As Integer
'These will get and "hold" the values of the start day
Dim xRow As Integer, xCol As Integer
'Now load every other day with the balance of the days....
Dim xBalance As Integer
Dim lngRow As Long
Dim lngCol As Long
xStart = "2010/11/09"
yEnd = "2010/12/12"
qDay = Day(xStart)
zDays = (yEnd - xStart) - 1 'Deduct the start date. Will load background to end date...
'zDays = Format(zDays, "dd")
dDay = qDay
xMonthStart = Month(xStart)
yMonthEnd = Month(yEnd)
'See if the month is the same, otherwise load the second month
If xMonthStart = yMonthEnd Then
'Load the grid with the begin date...
lstMonth.ListIndex = Month(xStart) - 1
lstYear.Text = Year(xStart)
'Find the day to start from...
For rRow = 0 To CalGrid.Rows - 1
For cCol = 0 To CalGrid.Cols - 1
strGrid = Format(CalGrid.TextMatrix(rRow, cCol), "##")
strGrid = Trim(strGrid)
If dDay = Mid(strGrid, 1, Len(strGrid)) Then
CalGrid.Row = rRow
xRow = rRow
CalGrid.Col = cCol
xCol = cCol
CalGrid.CellBackColor = vbRed
Exit For
Exit For
End If
Next cCol
Next rRow
lngRow = xRow
lngCol = xCol
'First put an if then in here because an error will be raised when the end of a coloumn is reached...
'We know that there are 6 rows and 7 coloumns to work with, so....
With CalGrid
For xBalance = 0 To zDays '28 days in this case, remember the 2 days deducted previously!
If xCol + 1 > .Cols - 1 Then
xRow = xRow + 1
.Row = xRow
xCol = 0 'Set back to zero to start recounting
.Col = 0
.CellBackColor = vbRed
ElseIf xRow + 1 > .Rows - 1 Then
Exit For
Else
.Col = xCol + 1
.CellBackColor = vbRed
xCol = xCol + 1
End If
Next xBalance
End With
Else 'Load second month
'Now, we need to add a follow over to the next month if there is a trial over
'from the start date to the end date.
'Enlarge the grid to show the next trialing month with the added dates
'highlighted....
'Enlarge the grid rows to 12 and increase its height
CalGrid.Rows = 11
CalGrid.Height = (450 * 11) + 100
'Load the grid with the begin date...
lstMonth.ListIndex = Month(xStart) - 1
lstYear.Text = Year(xStart)
'call the load of second month...
'Call TwoMonthCalender
'Change back colour again after the grid is re-populated
'Find the day to start from...
For rRow = 0 To CalGrid.Rows - 1
For cCol = 0 To CalGrid.Cols - 1
strGrid = Format(CalGrid.TextMatrix(rRow, cCol), "##")
strGrid = Trim(strGrid)
If dDay = Mid(strGrid, 1, Len(strGrid)) Then
Call TwoMonthCalender
CalGrid.Row = rRow
xRow = rRow
CalGrid.Col = cCol
xCol = cCol
CalGrid.CellBackColor = vbRed
Exit For
Exit For
End If
Next cCol
Next rRow
lngRow = xRow
lngCol = xCol
With CalGrid
For xBalance = 0 To zDays '28 days in this case, remember the 2 days deducted previously!
If xCol + 1 > .Cols - 1 Then
xRow = xRow + 1
.Row = xRow
xCol = 0 'Set back to zero to start recounting
.Col = 0
.CellBackColor = vbRed
ElseIf xRow + 1 > .Rows - 1 Then
Exit For
Else
.Col = xCol + 1
.CellBackColor = vbRed
xCol = xCol + 1
End If
Next xBalance
End With
End If
End SubEnjoy....:)
divakar.it 4 Junior Poster in Training
Thanks a lot for the effort you put in. can you please tell me how to include this code. My understanding is
- Insert a button in the form that you have given and assign the command_button Click code
- Copy the Private Sub TwoMonthCalender() code and paste it inside the form.
Kindly confirm
divakar.it 4 Junior Poster in Training
I have tried the code but I feel am going out of track. I hope the code is not yet completed as the colouring is not spelling over to December. Moreover when i click the button its showing 2 months calender data in the form and if i click the button to next month its showing only one month in flexi grid. Hence the display of calender is inconsistancy. Moreover i have given 2 months as a example. Some time if a project taking 3 or 4 or 8 months, the resource calender should colour the whole 8 months period.
divakar.it 4 Junior Poster in Training
Hi AndreRet,
I found the solution for my requirement. I have used Monthview and using the below code to fulfill the need.
Sub MonthView1_GetDayBold(ByVal StartDate As Date, _
ByVal Count As Integer, State() As Boolean)
Dim i As Long, d As Date, A As Date, B As Date, DDif As Integer
A = "11-Nov-2010"
B = "12-Dec-2010"
d = StartDate
For i = 0 To Count - 1
If d >= A And d <= B Then
State(i) = True ' Mark all blocked days.
End If
d = d + 1
Next
End SubThank you so much for your effort
AndreRet commented: Well done. +4
AndreRet 526 Senior Poster
Nicely done.:)
I did however thought that you wanted to change the date BACKGROUND colour, not the actual text, my err.
Be a part of the DaniWeb community
We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.