VB 6 Calendar

CoolEJ · October 8th, 2007, 05:20 AM

Hi, I am having problem fixng this Calendar code. I hope someone out there is patient to go through this code. Here are my troubles.
1. I can't get he desired output Month/[u]day</u>/Year ... particularly the day.
2. The event of updating the output to label1 happens only once after clicking one of the day buttons. How can it be set to always update whenever the day button is clicked?

I would surely appreciate any help.

Thanks...

Dim mon As Integer
Dim currentDay1 As Integer
Dim cmbMonthCurrentValue As String
Dim cmbYearCurrentValue As String
Dim formLoadFlagForMonth As Integer
Dim formLoadFlagForYear As Integer

Private Sub ComboMonth_Change()

    If formLoadFlagForMonth = 1 Then
        mon = Month(Date)
        ComboMonth.Text = MonthName(mon)
        formLoadFlagForMonth = 0
    ElseIf formLoadFlagForMonth = 0 Then
        ComboMonth.Text = cmbMonthCurrentValue
    End If

End Sub

Private Sub Comboyear_Change()

    If formLoadFlagForYear = 1 Then
        Comboyear.Text = Year(Date)
        formLoadFlagForYear = 0
    ElseIf formLoadFlagForYear = 0 Then
        Comboyear.Text = cmbYearCurrentValue
    End If

End Sub

Private Sub ComboMonth_Click()
    On Error Resume Next
    cmbMonthCurrentValue = ComboMonth.Text
    Select Case ComboMonth.Text
        Case "January"
            dispMonth = 1
        Case "February"
            dispMonth = 2
        Case "March"
            dispMonth = 3
        Case "April"
            dispMonth = 4
        Case "May"
            dispMonth = 5
        Case "June"
            dispMonth = 6
        Case "July"
            dispMonth = 7
        Case "August"
            dispMonth = 8
        Case "September"
            dispMonth = 9
        Case "October"
            dispMonth = 10
        Case "November"
            dispMonth = 11
        Case "December"
            dispMonth = 12
    End Select

    combodate = dispMonth & "/1/" & Comboyear.Text
    dispd = DatePart("w", combodate)
    month1 = dispd
    dayofmonth = (month1 - 1)

    nextdate = DateAdd("m", 1, combodate)
    daycount = DateDiff("d", combodate, nextdate)

    For i = 1 To daycount
        Command1(dayofmonth).Caption = i
        Command1(dayofmonth).BackColor = &H8000000F
        dayofmonth = dayofmonth + 1
    Next

    For j = dayofmonth To 41
        Command1(j).Caption = ""
    Next

    For j = 0 To (month1 - 2)
        Command1(j).Caption = ""
    Next

    crmonth = Month(Date)
    cryear = Year(Date)
    If ComboMonth.Text <> MonthName(crmonth) Then
        Command1(currentDay1).BackColor = &H8000000F
    ElseIf cryear = Year(Date) Then
        Command1(currentDay1).BackColor = &HFFFF&
    End If

    Call filltext

    lmonthname.Caption = ComboMonth.Text & " " & Comboyear.Text

End Sub

Private Sub ComboMonth_GotFocus()
    formLoadFlagForMonth = 0
End Sub

Private Sub Comboyear_GotFocus()
    formLoadFlagForYear = 0
End Sub

Private Sub Comboyear_Click()
    On Error Resume Next
    cmbYearCurrentValue = Comboyear.Text
    Select Case ComboMonth.Text
        Case "January"
            dispMonth = 1
        Case "February"
            dispMonth = 2
        Case "March"
            dispMonth = 3
        Case "April"
            dispMonth = 4
        Case "May"
            dispMonth = 5
        Case "June"
            dispMonth = 6
        Case "July"
            dispMonth = 7
        Case "August"
            dispMonth = 8
        Case "September"
            dispMonth = 9
        Case "October"
            dispMonth = 10
        Case "November"
            dispMonth = 11
        Case "December"
            dispMonth = 12
    End Select

    combodate = dispMonth & "/1/" & Comboyear.Text
    dispd = DatePart("w", combodate)
    month1 = dispd
    dayofmonth = (month1 - 1)

    nextdate = DateAdd("m", 1, combodate)
    daycount = DateDiff("d", combodate, nextdate)

    For i = 1 To daycount
        Command1(dayofmonth).Caption = i
        Command1(dayofmonth).BackColor = &H8000000F
        dayofmonth = dayofmonth + 1
    Next

    For j = dayofmonth To 41
        Command1(j).Caption = ""
    Next

    For j = 0 To (month1 - 2)
        Command1(j).Caption = ""
    Next

    crmonth = Month(Date)
    cryear = Year(Date)
    If ComboMonth.Text <> MonthName(crmonth) Then
        Command1(currentDay1).BackColor = &H8000000F
    ElseIf cryear = Comboyear.Text Then
        Command1(currentDay1).BackColor = &HFFFF&
    End If

    Call filltext

    lmonthname.Caption = ComboMonth.Text & " " & Comboyear.Text

End Sub

Private Sub Form_Load()

    formLoadFlagForMonth = 1
    formLoadFlagForYear = 1

    flag = 0
    ComboMonth.AddItem ("January")
    ComboMonth.AddItem ("February")
    ComboMonth.AddItem ("March")
    ComboMonth.AddItem ("April")
    ComboMonth.AddItem ("May")
    ComboMonth.AddItem ("June")
    ComboMonth.AddItem ("July")
    ComboMonth.AddItem ("August")
    ComboMonth.AddItem ("September")
    ComboMonth.AddItem ("October")
    ComboMonth.AddItem ("November")
    ComboMonth.AddItem ("December")

    For i = 1900 To 2100
        Comboyear.AddItem (i)
    Next

    mon = Month(Date)
    ComboMonth.Text = MonthName(mon)
    Comboyear.Text = Year(Date)

    cmbMonthCurrentValue = ComboMonth.Text
    cmbYearCurrentValue = Comboyear.Text

    combodate = mon & "/1/" & Comboyear.Text
    dispdate = DatePart("w", combodate)
    month2 = dispdate
    totaldayofmonth = (month2 - 1)
    nextdate = DateAdd("m", 1, combodate)
    daycount = DateDiff("d", combodate, nextdate)

    For i = 1 To daycount
        Command1(totaldayofmonth).Caption = i
        Command1(totaldayofmonth).BackColor = &H8000000F
        'SetButtonForecolor Command1(totaldayofmonth).hWnd, vbBlue
        totaldayofmonth = totaldayofmonth + 1
    Next
    lmonthname.Caption = ComboMonth.Text & " " & Comboyear.Text

    currentday = Day(Date)
    currentDay1 = (month2 + currentday) - 2
    Command1(currentDay1).BackColor = &HFFFF&

    Call filltext

End Sub

Private Sub filltext()
    'On Error Resume Next
    find = 0
    For j = 0 To 41

        If Command1(j).Caption <> "" And find = 0 Then
            find = 1
            First = j
        End If

        If Command1(j).Caption = "" And find = 1 Then
            enday = j
            Exit For
        End If

    Next

    presentdate = ComboMonth.Text & "/1/" & Comboyear.Text
    previousdate = DateAdd("d", -1, presentdate)
    PreviousDay = Day(previousdate)

    k = (First - 1)
    While k >= 0
        Command1(k).Caption = PreviousDay
        Command1(k).BackColor = &H808080
        SetButtonForecolor Command1(k).hWnd, vbBlack
        PreviousDay = PreviousDay - 1
        k = k - 1
    Wend

    nextdate = DateAdd("m", 1, presentdate)
    NextDay = Day(nextdate)

    k = enday
    While k <= 41
        Command1(k).Caption = NextDay
        Command1(k).BackColor = &H808080
        SetButtonForecolor Command1(k).hWnd, vbBlack
        NextDay = NextDay + 1
        k = k + 1
    Wend
    Call ChangeColorOfCurrentMonth

End Sub

Private Sub Command1_Click(Index As Integer)
    On Error Resume Next

    formLoadFlagForMonth = 2
    formLoadFlagForYear = 2

    For k = 0 To 6
        If Command1(k).Caption = 1 Then
            limit = (k - 1)
            Exit For
        End If
    Next

    presentdate = ComboMonth.Text & "/1/" & Comboyear.Text
    PreviousMonth = DateAdd("d", -1, presentdate)
    pmonth = Month(PreviousMonth)
    prevmonth = MonthName(pmonth)
    yearcheck = Year(PreviousMonth)

    If Index >= 0 And Index <= limit Then
        ComboMonth.Text = prevmonth
        Comboyear.Text = yearcheck
        Call ComboMonth_Click
    End If

    For k = 25 To 41
        If Command1(k).Caption = 1 Then
            limit = k
            Exit For
        End If
    Next

    presentdate = ComboMonth.Text & "/1/" & Comboyear.Text
    NextMonth = DateAdd("m", 1, presentdate)
    nmonth = Month(NextMonth)
    NextMonth1 = MonthName(nmonth)
    yearcheck = Year(NextMonth)

    If Index >= limit And Index <= 41 Then
        ComboMonth.Text = NextMonth1
        Comboyear.Text = yearcheck
        Call ComboMonth_Click
    End If

    ' inserted

    Label1 = ComboMonth.Text & "/" & Command1(k).Caption & "/" & Comboyear.Text

End Sub

Public Sub ChangeColorOfCurrentMonth()

    For i = 0 To 6
        If Command1(i).Caption = 1 Then
            FirstDay = i
            Exit For
        End If
    Next

    For j = FirstDay + 1 To 41
        If Command1(j).Caption = 1 Then
            lastday = j - 1
            Exit For
        End If
    Next

    For k = FirstDay To lastday
        SetButtonForecolor Command1(k).hWnd, vbBlue
    Next

End Sub

EJC

Shasur · October 8th, 2007, 05:49 AM

Why can't you try this with Microsoft Calendar Control instead of
comboboxes

You can add the control to the form from the Components ITem. If this is not listed browse for c:\Program Files\Microsoft Office\office11\mscal.ocx

Then in the Calendar's click event you can get the Value you want

Private Sub Calendar1_Click()

txtStartDate.Text = Calendar1.Value

End Sub

You can also Format the date using Format Function

Cheers
Shasur

http://www.dotnetdud.blogspot.com

VBA Tips & Tricks (http://www.vbadud.blogspot.com)

CoolEJ · October 8th, 2007, 06:35 PM

Sorry if this sounds dumb... How do I open that in VB 6 studio? Or how do I call it to come up and connect the date clicked to a certain field?

Thanks once again.

EJC

Shasur · October 8th, 2007, 11:59 PM

Hi

You need to got to Projects-->Components

Under the controls tab you will see lots of components listed. Scroll down to Microsoft Calendar Control and select the check box and Click OK

You will find the Calendar Control added to the toolbox. Drag it on your form and place wherever it is necessary

Regards
Shasur

http://www.dotnetdud.blogspot.com

VBA Tips & Tricks (http://www.vbadud.blogspot.com)

CoolEJ · October 9th, 2007, 02:26 AM

It's finally working! :)

Thanks a lot man!

EJC