' ---------------------------------------------------------------
' Custom Project 9-1
' ---------------------------------------------------------------


Private Sub Form_Load()
    With Me.cboEndDate
        .SetFocus
        .ListIndex = 5     ' Select current ending date
    End With
End Sub

Private Sub cboEndDate_Change()
    Dim endDate As Date
    
    endDate = Me.cboEndDate.Value
    With Me
        .txt1 = Format(endDate - 6, "mm/dd")
        .txt2 = Format(endDate - 5, "mm/dd")
        .txt3 = Format(endDate - 4, "mm/dd")
        .txt4 = Format(endDate - 3, "mm/dd")
        .txt5 = Format(endDate - 2, "mm/dd")
        .txt6 = Format(endDate - 1, "mm/dd")
        .txt7 = Format(endDate - 0, "mm/dd")
    End With
End Sub

Function ListEndDates(fld As Control, id As Variant, _
    row As Variant, col As Variant, code As Variant) As Variant
    Dim intOffset As Integer
    
    Select Case code
        Case acLBInitialize
            ListEndDates = True
        Case acLBOpen
            ListEndDates = Timer
        Case acLBGetRowCount
            ListEndDates = 11
        Case acLBGetColumnCount
            ListEndDates = 1
        Case acLBGetColumnWidth
            ListEndDates = -1
        Case acLBGetValue
            ' days till ending date
            intOffset = Abs((8 - Weekday(Now)) Mod 7)
            
            ' start 5 weeks prior to current week ending date
            ' (7 days * 5 weeks = 35 days before next ending date)
            ' and show 11 dates

            ListEndDates = Format(((Now() + intOffset) - 35) _
                 + 7 * row, "MM/DD/YYYY")
    End Select
End Function


' ---------------------------------------------------------------
' Hands-On 9-1
' ---------------------------------------------------------------


Sub WhatDate()
    Dim curDate As Date
    Dim newDate As Date
    Dim x As Integer
    
    curDate = Date
    For x = 1 To 365
        newDate = Date + x
    Next x
End Sub


'----------------------------------------------------------------
' Hands-On 9-2
' No code for this Hands-On. 
' Please follow the instructions in the book.
'----------------------------------------------------------------


'----------------------------------------------------------------
' Hands-On 9-3
' No code for this Hands-On. 
' Please follow the instructions in the book.
'----------------------------------------------------------------


'----------------------------------------------------------------
' Hands-On 9-4
' No code for this Hands-On. 
' Please follow the instructions in the book.
'----------------------------------------------------------------


' ---------------------------------------------------------------
' Hands-On 9-5
' ---------------------------------------------------------------


Sub MyProcedure()
    Dim myName As String
    
    myName = Forms!frmTimeSheet.Controls(1).Name
    
    ' choose Step Over to avoid stepping through the
    ' lines of code in the called procedure - SpecialMsg
    SpecialMsg myName
End Sub
    
Sub SpecialMsg(n As String)
    If n = "Label1" Then
        MsgBox "You must change the name."
    End If
End Sub


' ---------------------------------------------------------------
' Hands-On 9-6
' ---------------------------------------------------------------

' declare a conditional compiler constant
#Const verSpanish = True

Sub WhatDay()
    Dim dayNr As Integer
    #If verSpanish = True Then
        dayNr = Weekday(InputBox("Entre la fecha, por ejemplo 01/01/2007"))
        MsgBox "Sera " & DayOfWeek(dayNr) & "."
    #Else
        WeekdayName
    #End If
End Sub
    
Function DayOfWeek(dayNr As Integer) As String
    DayOfWeek = Choose(dayNr, "Domingo", "Lunes", "Martes", _
        "Miercoles", "Jueves", "Viernes", "Sabado")
End Function
    
Function WeekdayName() As String
    Select Case Weekday(InputBox("Enter date, e.g., 01/01/2007"))
        Case 1
            WeekdayName = "Sunday"
        Case 2
            WeekdayName = "Monday"
        Case 3
            WeekdayName = "Tuesday"
        Case 4
            WeekdayName = "Wednesday"
        Case 5
            WeekdayName = "Thursday"
        Case 6
            WeekdayName = "Friday"
        Case 7
            WeekdayName = "Saturday"
    End Select
    MsgBox "It will be " & WeekdayName & "."
End Function



' ---------------------------------------------------------------
' Hands-On 9-7
' ---------------------------------------------------------------

Sub OpenToRead()
    Dim myFile As String
    Dim myChar As String
    Dim myText As String
    Dim FileExists As Boolean
    
    FileExists = True
    
    On Error GoTo ErrorHandler
    myFile = InputBox("Enter the name of file you want to open:")
    Open myFile For Input As #1
    If FileExists Then
        Do While Not EOF(1)            ' loop until the end of file
            myChar = Input(1, #1)      ' get one character
            myText = myText + myChar   ' store in the variable myText
        Loop
        Debug.Print myText             ' print to the Immediate window
        ' Close the file - commenting out this instruction will cause 
        ' error 52.
        Close #1
    End If
    Exit Sub
    
ErrorHandler:
    FileExists = False
    Select Case Err.Number
        Case 71
            MsgBox "The diskette drive is empty."
        Case 53
            MsgBox "This file can't be found on the specified drive."
        Case 75
            Exit Sub
        Case Else
            MsgBox "Error " & Err.Number & " :" & Error(Err.Description)
            Exit Sub
    End Select
    Resume Next
End Sub


'----------------------------------------------------------------
' Hands-On 9-8
' No code for this Hands-On. 
' Please follow the instructions in the book.
'----------------------------------------------------------------


'----------------------------------------------------------------
' Statements to be entered in the Immediate Window
' (See book page 193)
'----------------------------------------------------------------

Error 11
?Error(7)


