Может у кагота завалялся код? У меня учитель "мозг" за два дня сказал зделать календарь и нечего толком необяснил. Я вижуал бейсик откуда знаю???
Вот что получилось:
Code:
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
Принцып работы, мол воодиш в Бокс год и месяц- выводится правельный календарь.
Неполучилось придумать как хоть с месяцами разобратся, я этот язык незнаю