Code: Select all
.Private Sub FILL_LISTVIEW()
Dim ITMX As ListItem
Dim strDay As String
Dim D As Long
Dim M As Long
Dim STRDATA As String
With Me.ListView1
.ListItems.Clear
For D = 1 To 31
STRDATA = Format(D, "00") & "/" & "01/" & ANNO
Set ITMX = .ListItems.Add(, , STRDATA)
If Weekday(STRDATA) = 1 Or Weekday(STRDATA) = 7 Then
ITMX.ForeColor = &HFF&
End If
For M = 2 To 12
strDay = ""
Select Case M
Case 2
If D < 29 - (ANNO Mod 4 = 0) Then
STRDATA = Format(D, "00") & "/" & Format(M, "00") & "/" & ANNO
strDay = STRDATA
End If
Case 4, 6, 9, 11
If D < 31 Then
STRDATA = Format(D, "00") & "/" & Format(M, "00") & "/" & ANNO
strDay = STRDATA
End If
Case 3, 5, 7, 8, 10, 12
STRDATA = Format(D, "00") & "/" & Format(M, "00") & "/" & ANNO
strDay = STRDATA
End Select
ITMX.ListSubItems.Add , , strDay
Next
Next
Me.LGIORNO.Caption = Me.ListView1.ListItems(1).Text
Set ITMX = Nothing
End With
End Sub