Yoko

Code: Select all

Dim YearNumber As String
Dim NameofMonth As String
Public SidesM As Integer
Public SidesY As Integer
Public FormCancelled As Boolean
Public Sub InitializeForm()
FormCancelled = True
MyEntryForm.EntryBoxYear.Value = 2005
MyEntryForm.EntryBoxMonth.Value = 12
MyEntryForm.SpinButtonYear.Value = MyEntryForm.EntryBoxYear.Value
MyEntryForm.SpinButtonMonth.Value = MyEntryForm.EntryBoxMonth.Value
End Sub
Public Sub Delete()
Cells.Select
Selection.ClearContents
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Interior.ColorIndex = xlNone
    Selection.Font.ColorIndex = 0
    Selection.Font.Bold = False
    Selection.Font.Italic = False
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
Range("A1").Select
End Sub
Sub Macro_Date()
    Delete
    InitializeForm
    MyEntryForm.Show
    Create_Table
    StartRow = ActiveCell.Row
    StartColumn = ActiveCell.Column
    Cells(StartRow, StartColumn) = NameofMonth & "-" & YearNumber
    Cells(StartRow + 1, StartColumn) = "Mon"
    Cells(StartRow + 2, StartColumn) = "Tue"
    Cells(StartRow + 3, StartColumn) = "Wed"
    Cells(StartRow + 4, StartColumn) = "Thu"
    Cells(StartRow + 5, StartColumn) = "Fri"
    Cells(StartRow + 6, StartColumn) = "Sat"
    Cells(StartRow + 7, StartColumn) = "Sun"
   
    For WeekofMonth = 0 To 5
        For DayofWeek = StartDay To 6
            If DayNumber < 32 Then
                Cells(StartRow + 1 + DayofWeek, StartColumn + 1 + WeekofMonth) = DayNumber
            End If
            DayNumber = DayNumber + 1
        Next DayofWeek
        StartDay = 0
    Next WeekofMonth
End Sub
Public Sub CheckMonth()

Cells(StartRow, StartColumn) = NameofMonth & "-" & YearNumber

    NameofMonth = ...
    If NameofMonth = “January” or NameofMonth = “March”     ... or NameofMonth = “December” then LastDay= 31
    If NameofMonth = “April” or NameofMonth = “June” ...    or NameofMonth = “November” then LastDay= 30
    …
   
    If DayNumber <= LastDay Then
    ...
End Sub
Public Sub Create_Table()
    Delete
    Range("A1:B1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A2:F8").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("A8:F8,A1:B1").Select
    Range("A1").Activate
    With Selection.Interior
        .ColorIndex = 40
        .Pattern = xlSolid
    End With
    Range("A8:F8").Select
    Range("F8").Activate
    Range("A8:F8,A2:A8").Select
    Selection.Font.Bold = True
    Range("A7:F8").Select
    Range("F8").Activate
    Selection.Font.ColorIndex = 3
    Range("A1").Select
End Sub