filling calendar in listview

[sal21]

Code: Select all

Option Explicit
Private Sub Form_Load()

    Dim I As Integer

    With Me.CANNO
        .Clear
        For I = Year(Now) To Year(Now) + 2
            .AddItem I
        Next I
    End With

    With Me.CMESE
        .Clear
        .AddItem "01-GENNAIO"
        .AddItem "02-FEBBRAIO"
        .AddItem "03-MARZO"
        .AddItem "04-APRILE"
        .AddItem "05-MAGGIO"
        .AddItem "06-GIUGNO"
        .AddItem "07-LUGLIO"
        .AddItem "08-AGOSTO"
        .AddItem "09-SETTEMBRE"
        .AddItem "10-OTTOBRE"
        .AddItem "11-NOVEMBRE"
        .AddItem "12-DICEMBRE"
    End With

End Sub

possible to have the same calendar in listview, based the immagine1

for example:

month 05-MAGGIO in combobox MESE
year 2020 in combobox ANNO

[HansV]

I'll get back to you later today, no time now.

[sal21]

I'll get back to you later today, no time now.

no prob!

[HansV]

Like this:

Code: Select all

Private Sub CANNO_Change()
    Call FillCalendar
End Sub

Private Sub CMESE_Change()
    Call FillCalendar
End Sub
Private Sub FillCalendar()
    Dim a As Long
    Dim m As Long
    Dim d0 As Date
    Dim d1 As Date
    Dim d2 As Date
    Dim d As String
    Dim itm As ListItem
    Dim i As Long
    a = Val(Me.CANNO)
    m = Val(Me.CMESE)
    ' Check for empty year or month
    If a = 0 Then
        Me.CANNO.SetFocus
        MsgBox "Please select a year"
        Exit Sub
    End If
    If m = 0 Then
        Me.CMESE.SetFocus
        MsgBox "Please select a month"
        Exit Sub
    End If
    Me.ListView1.ListItems.Clear
    ' First day of the month
    d1 = DateSerial(a, m, 1)
    ' Last day of the month
    d2 = DateSerial(a, m + 1, 0)
    ' Monday on or before the first day
    d0 = d1 + 1 - Weekday(d1, vbMonday)
    Do
        If d0 < d1 Or d0 > d2 Then
            d = ""
        Else
            d = Day(d0)
        End If
        Set itm = Me.ListView1.ListItems.Add(Text:=d)
        For i = 1 To 6
            d0 = d0 + 1
            If d0 < d1 Or d0 > d2 Then
                d = ""
            Else
                d = Day(d0)
            End If
            itm.ListSubItems.Add Index:=i, Text:=d
        Next i
        d0 = d0 + 1
    Loop Until d0 > d2
End Sub

[sal21]

Like this:

Code: Select all

Private Sub CANNO_Change()
    Call FillCalendar
End Sub

Private Sub CMESE_Change()
    Call FillCalendar
End Sub
Private Sub FillCalendar()
    Dim a As Long
    Dim m As Long
    Dim d0 As Date
    Dim d1 As Date
    Dim d2 As Date
    Dim d As String
    Dim itm As ListItem
    Dim i As Long
    a = Val(Me.CANNO)
    m = Val(Me.CMESE)
    ' Check for empty year or month
    If a = 0 Then
        Me.CANNO.SetFocus
        MsgBox "Please select a year"
        Exit Sub
    End If
    If m = 0 Then
        Me.CMESE.SetFocus
        MsgBox "Please select a month"
        Exit Sub
    End If
    Me.ListView1.ListItems.Clear
    ' First day of the month
    d1 = DateSerial(a, m, 1)
    ' Last day of the month
    d2 = DateSerial(a, m + 1, 0)
    ' Monday on or before the first day
    d0 = d1 + 1 - Weekday(d1, vbMonday)
    Do
        If d0 < d1 Or d0 > d2 Then
            d = ""
        Else
            d = Day(d0)
        End If
        Set itm = Me.ListView1.ListItems.Add(Text:=d)
        For i = 1 To 6
            d0 = d0 + 1
            If d0 < d1 Or d0 > d2 Then
                d = ""
            Else
                d = Day(d0)
            End If
            itm.ListSubItems.Add Index:=i, Text:=d
        Next i
        d0 = d0 + 1
    Loop Until d0 > d2
End Sub

[sal21]

But how to get the value 15, when i click on listview?
similar a Naval Battle X,Y coordinate

I know only to get the row with:

Code: Select all

Private Sub CALENDAR_Click()

    Dim L As Long
    L = Empty
    L = Me.CALENDAR.SelectedItem.Index

End Sub

but how to get the related column index?

[HansV]

Why don't you use the MonthView control? Wouldn't that be a lot easier?

[sal21]

Why don't you use the MonthView control? Wouldn't that be a lot easier?

MonthView???

Never used...

[HansV]

I'd try it...