Convert the numbers on the grid to a date

[divakar.it]

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

[AndreRet]

No problem. I'll post it today.:)

[AndreRet]

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]

Thank Guruji (Guruji means teacher). Will have a try and let u know incase of any issues

[AndreRet]

"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]

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]

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]

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 Sub

Enjoy....:)

[divakar.it]

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]

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]

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 Sub

Thank you so much for your effort

[AndreRet]

Nicely done.:)

I did however thought that you wanted to change the date BACKGROUND colour, not the actual text, my err.