LISTVIEW AND DATE

[sal21]

How to have the same effect with a listview?
based MyVaYear=2020


Attached is a Grid image

note:
for problem of space in uplod i have truncated the image
header (Year) of column is just filed from other code.

[HansV]

It is not possible to color individual cells in a listview control.

[HansV]

See listview background color

[sal21]

See listview background color

No.
I Need to fill Cells in each column with a value date.
Symple for you...

[HansV]

Here is code to populate the listview:

Code: Select all

Sub FillListView()
    Dim ANNO As Long
    Dim MESE As Long
    Dim GIORNO As Long
    Dim GIORNI As Long
    Dim LVW As ListView
    Dim ITM As ListItem
    ANNO = 2020
    Set LVW = Me.ListView1
    LVW.View = lvwReport
    LVW.Gridlines = True
    For MESE = 1 To 12
        LVW.ColumnHeaders.Add Text:=UCase(MonthName(MESE))
    Next MESE
    For GIORNO = 1 To 31
        Set ITM = LVW.ListItems.Add(Text:=UCase(Format(DateSerial(ANNO, 1, GIORNO), "dd ddd")))
        For MESE = 2 To 12
            GIORNI = Day(DateSerial(ANNO, MESE + 1, 0))
            If GIORNO <= GIORNI Then
                ITM.ListSubItems.Add Text:=UCase(Format(DateSerial(ANNO, MESE, GIORNO), "dd ddd"))
            Else
                ITM.ListSubItems.Add Text:=""
            End If
        Next MESE
    Next GIORNO
End Sub

[sal21]

Here is code to populate the listview:

Code: Select all

Sub FillListView()
    Dim ANNO As Long
    Dim MESE As Long
    Dim GIORNO As Long
    Dim GIORNI As Long
    Dim LVW As ListView
    Dim ITM As ListItem
    ANNO = 2020
    Set LVW = Me.ListView1
    LVW.View = lvwReport
    LVW.Gridlines = True
    For MESE = 1 To 12
        LVW.ColumnHeaders.Add Text:=UCase(MonthName(MESE))
    Next MESE
    For GIORNO = 1 To 31
        Set ITM = LVW.ListItems.Add(Text:=UCase(Format(DateSerial(ANNO, 1, GIORNO), "dd ddd")))
        For MESE = 2 To 12
            GIORNI = Day(DateSerial(ANNO, MESE + 1, 0))
            If GIORNO <= GIORNI Then
                ITM.ListSubItems.Add Text:=UCase(Format(DateSerial(ANNO, MESE, GIORNO), "dd ddd"))
            Else
                ITM.ListSubItems.Add Text:=""
            End If
        Next MESE
    Next GIORNO
End Sub

ALL work perfect, but i dont see in second row the name of month...

[HansV]

The month names are the column headers.

[sal21]

The month names are the column headers.

OK.
DISTRACT!

possible to change color text in date if the date is DOMENICA?

[HansV]

Like this:

Code: Select all

Sub FillListView()
    Dim ANNO As Long
    Dim MESE As Long
    Dim GIORNO As Long
    Dim GIORNI As Long
    Dim LVW As ListView
    Dim ITM As ListItem
    Dim SITM As ListSubItem
    Dim DATO As Date
    ANNO = 2020
    Set LVW = Me.ListView1
    LVW.View = lvwReport
    LVW.Gridlines = True
    For MESE = 1 To 12
        LVW.ColumnHeaders.Add Text:=UCase(MonthName(MESE))
    Next MESE
    For GIORNO = 1 To 31
        DATO = DateSerial(ANNO, 1, GIORNO)
        Set ITM = LVW.ListItems.Add(Text:=UCase(Format(DateSerial(ANNO, 1, GIORNO), "dd ddd")))
        If Weekday(DATO) = 1 Then
            ITM.ForeColor = vbRed
        End If
        For MESE = 2 To 12
            GIORNI = Day(DateSerial(ANNO, MESE + 1, 0))
            If GIORNO <= GIORNI Then
                DATO = DateSerial(ANNO, MESE, GIORNO)
                Set SITM = ITM.ListSubItems.Add(Text:=UCase(Format(DATO, "dd ddd")))
                If Weekday(DATO) = 1 Then
                    SITM.ForeColor = vbRed
                End If
            Else
                ITM.ListSubItems.Add Text:=""
            End If
        Next MESE
    Next GIORNO
End Sub

[sal21]

Like this:

Code: Select all

Sub FillListView()
    Dim ANNO As Long
    Dim MESE As Long
    Dim GIORNO As Long
    Dim GIORNI As Long
    Dim LVW As ListView
    Dim ITM As ListItem
    Dim SITM As ListSubItem
    Dim DATO As Date
    ANNO = 2020
    Set LVW = Me.ListView1
    LVW.View = lvwReport
    LVW.Gridlines = True
    For MESE = 1 To 12
        LVW.ColumnHeaders.Add Text:=UCase(MonthName(MESE))
    Next MESE
    For GIORNO = 1 To 31
        DATO = DateSerial(ANNO, 1, GIORNO)
        Set ITM = LVW.ListItems.Add(Text:=UCase(Format(DateSerial(ANNO, 1, GIORNO), "dd ddd")))
        If Weekday(DATO) = 1 Then
            ITM.ForeColor = vbRed
        End If
        For MESE = 2 To 12
            GIORNI = Day(DateSerial(ANNO, MESE + 1, 0))
            If GIORNO <= GIORNI Then
                DATO = DateSerial(ANNO, MESE, GIORNO)
                Set SITM = ITM.ListSubItems.Add(Text:=UCase(Format(DATO, "dd ddd")))
                If Weekday(DATO) = 1 Then
                    SITM.ForeColor = vbRed
                End If
            Else
                ITM.ListSubItems.Add Text:=""
            End If
        Next MESE
    Next GIORNO
End Sub