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.
LISTVIEW AND DATE
-
- PlatinumLounger
- Posts: 4374
- Joined: 26 Apr 2010, 17:36
LISTVIEW AND DATE
You do not have the required permissions to view the files attached to this post.
-
- Administrator
- Posts: 78647
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: LISTVIEW AND DATE
It is not possible to color individual cells in a listview control.
Best wishes,
Hans
Hans
-
- Administrator
- Posts: 78647
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
-
- PlatinumLounger
- Posts: 4374
- Joined: 26 Apr 2010, 17:36
Re: LISTVIEW AND DATE
No.
I Need to fill Cells in each column with a value date.
Symple for you...
-
- Administrator
- Posts: 78647
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: LISTVIEW AND DATE
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
Best wishes,
Hans
Hans
-
- PlatinumLounger
- Posts: 4374
- Joined: 26 Apr 2010, 17:36
Re: LISTVIEW AND DATE
ALL work perfect, but i dont see in second row the name of month...HansV wrote: ↑14 Jul 2020, 19:47Here 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
-
- Administrator
- Posts: 78647
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
-
- PlatinumLounger
- Posts: 4374
- Joined: 26 Apr 2010, 17:36
-
- Administrator
- Posts: 78647
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: LISTVIEW AND DATE
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
Best wishes,
Hans
Hans
-
- PlatinumLounger
- Posts: 4374
- Joined: 26 Apr 2010, 17:36
Re: LISTVIEW AND DATE
HansV wrote: ↑15 Jul 2020, 07:41Like 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