Option Explicit On
Public Class Form1
Dim YrNum As Long, MonthNum As Long, DayNum As Long, MonthDays As Integer, StartNum As Integer, EndNum As Integer
Dim StartDate As Date, SelectedDate As Date, ButtonNum As Integer, DateCounter As Long, CurMonth As Boolean
Private Sub MonthChange_Scroll(sender As Object, e As ScrollEventArgs) Handles MonthChange.Scroll
End Sub
Public Property WorksheetFunction As Object
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
Private Sub Lbl_Giorno_Mese_Click(sender As Object, e As EventArgs)
End Sub
Private Sub Cella1_Click(sender As Object, e As EventArgs) Handles Cella1.Click
On Error Resume Next
Me.("Cella" & ButtonNum).ForeColor = &HFF0000
ButtonNum = 1
SelectedDate = Cella1.Text & "/" & MonthNum & "/" & YrNum
SwitchBack()
End Sub
Private Sub Form1_Activated(sender As Object, e As EventArgs) Handles Me.Activated
On Error Resume Next
'Foglio1.Range("A5:F5").ClearContents
Me.Label1.Text = ""
Me.Label2.Text = ""
DateCounter = 1
YrNum = Year(Now())
DayNum = 1
Me.MonthChange.Value = Month(Now())
ButtonNum = 1
StartDate = DayNum & "/" & MonthNum & "/" & YrNum
Me.DateLabel.Text = Format(StartDate, "mmm yyyy")
Me.MonthChange_Change()
End Sub
Private Sub MonthChange_Change()
Throw New NotImplementedException()
End Sub
Private Function GetWorksheetFunction() As Object
Return WorksheetFunction
End Function
Private Sub MonthChange_Change(worksheetFunction As Object)
On Error Resume Next
If MonthChange.Value = 13 Then
YrNum = YrNum + 1
MonthChange.Value = 1
End If
If MonthChange.Value = 0 Then
YrNum = YrNum - 1
MonthChange.Value = 12
End If
MonthNum = MonthChange.Value
StartDate = DayNum & "/" & MonthNum & "/" & YrNum
Dim worksheetFunction1 As Object = worksheetFunction
StartNum = worksheetFunction1.Weekday(StartDate, 2)
MonthDays = EoMonth(StartDate, 0) - StartDate + &H1
DateLabel.Text = Format(StartDate, "mmm yyyy")
UpDateDisplay()
End Sub
Private Function EoMonth(startDate As Date, v As Integer) As Date
Throw New NotImplementedException()
End Function
Sub UpDateDisplay()
On Error Resume Next
Dim X As Integer
If MonthNum = Month(Now()) And YrNum = Year(Now()) Then
CurMonth = True
Else
CurMonth = False
End If
Me.SelectedDateLabel.Text = ""
'Reimposta la Visualizzazione Dei Tasti *********************************
For X = 28 To 38
Me.("Cella" & X).Visible = True
Next X
For X = 1 To StartNum - 1
Dim form1 As Form1 = Me
Me.("Cella" & X).Visible = False
Next X
Dim WorksheetFunction As Object = Nothing
For X = WorksheetFunction.Weekday(StartDate, 2) To 7
Me.("Cella" & X).Visible = True
Next X
'Rietichettare il pulsanti di visualizzazione *******************************
For X = StartNum To StartNum + MonthDays - 1
Me.("Cella" & X).Caption = X - StartNum + 1
If CurMonth = True And X - StartNum + 1 = Day(Now()) Then
Me.("Cella" & X).BackColor = &H80FFFF
Else
If ((X - 1) Mod 7) + 1 = 6 Or ((X - 1) Mod 7) + 1 = 7 Then
Me.("Cella" & X).ForeColor = 1
Me.("Cella" & X).BackColor = &H80FF80
Else
Me..("Cella" & X).ForeColor = 1
Me.("Cella" & X).BackColor = &H8000000F
End If
End If
Next X
'Nasconde i Tasti di fine Corsa ***********************************
For X = StartNum + MonthDays To 38
Me.("Cella" & X).Visible = False
Next X
End Sub
Private Function Day([date] As Date) As Integer
Throw New NotImplementedException()
End Function
Sub SwitchBack()
On Error Resume Next
Me.("Cella" & ButtonNum).ForeColor = &HFF&
SelectedDateLabel.Text = Format(SelectedDate, "dddd dd mmmm yyyy")
Me.Label1.Text = Format(SelectedDate, "dddd dd mmmm yyyy")
Me.Label2.Text = Format(SelectedDate, "mm/dd/yyyy")
DateCounter = DateCounter + 1
MonthChange.Focus()
End Sub
End Class