COLORIZE FONT LISTVIEW ITEM

User avatar
sal21
PlatinumLounger
Posts: 4334
Joined: 26 Apr 2010, 17:36

COLORIZE FONT LISTVIEW ITEM

Post by sal21 »

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

I only managed to do this on the first column....
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: COLORIZE FONT LISTVIEW ITEM

Post by HansV »

Code: Select all

Private Sub FILL_LISTVIEW()
    Dim ITMX As ListItem
    Dim ITMS As ListSubItem
    Dim dtm As Date
    Dim strDay As String
    Dim D As Long
    Dim M As Long

    With Me.ListView1
        .ListItems.Clear
        For D = 1 To 31
            dtm = DateSerial(ANNO, 1, D)
            strDay = Format(dtm, "dd/mm/yyyy")
            Set ITMX = .ListItems.Add(Text:=strDay)
            If Weekday(dtm) = 1 Or Weekday(dtm) = 7 Then
                ITMX.ForeColor = &HFF&
            End If
            For M = 2 To 12
                dtm = DateSerial(ANNO, M, D)
                strDay = ""
                Select Case M
                Case 2
                    If D < 29 - (ANNO Mod 4 = 0) Then
                        strDay = Format(dtm, "dd/mm/yyyy")
                    End If
                Case 4, 6, 9, 11
                    If D < 31 Then
                        strDay = Format(dtm, "dd/mm/yyyy")
                    End If
                Case 3, 5, 7, 8, 10, 12
                    strDay = Format(dtm, "dd/mm/yyyy")
                End Select
                Set ITMS = ITMX.ListSubItems.Add(Text:=strDay)
                If Weekday(dtm) = 1 Or Weekday(dtm) = 7 Then
                    ITMS.ForeColor = &HFF&
                End If
                
            Next
        Next
        Me.LGIORNO.Caption = Me.ListView1.ListItems(1).Text
        Set ITMX = Nothing
    End With
End Sub
Best wishes,
Hans

User avatar
sal21
PlatinumLounger
Posts: 4334
Joined: 26 Apr 2010, 17:36

Re: COLORIZE FONT LISTVIEW ITEM

Post by sal21 »

HansV wrote:
28 Sep 2022, 20:02

Code: Select all

Private Sub FILL_LISTVIEW()
    Dim ITMX As ListItem
    Dim ITMS As ListSubItem
    Dim dtm As Date
    Dim strDay As String
    Dim D As Long
    Dim M As Long

    With Me.ListView1
        .ListItems.Clear
        For D = 1 To 31
            dtm = DateSerial(ANNO, 1, D)
            strDay = Format(dtm, "dd/mm/yyyy")
            Set ITMX = .ListItems.Add(Text:=strDay)
            If Weekday(dtm) = 1 Or Weekday(dtm) = 7 Then
                ITMX.ForeColor = &HFF&
            End If
            For M = 2 To 12
                dtm = DateSerial(ANNO, M, D)
                strDay = ""
                Select Case M
                Case 2
                    If D < 29 - (ANNO Mod 4 = 0) Then
                        strDay = Format(dtm, "dd/mm/yyyy")
                    End If
                Case 4, 6, 9, 11
                    If D < 31 Then
                        strDay = Format(dtm, "dd/mm/yyyy")
                    End If
                Case 3, 5, 7, 8, 10, 12
                    strDay = Format(dtm, "dd/mm/yyyy")
                End Select
                Set ITMS = ITMX.ListSubItems.Add(Text:=strDay)
                If Weekday(dtm) = 1 Or Weekday(dtm) = 7 Then
                    ITMS.ForeColor = &HFF&
                End If
                
            Next
        Next
        Me.LGIORNO.Caption = Me.ListView1.ListItems(1).Text
        Set ITMX = Nothing
    End With
End Sub
:clapping:

... why a new dtm dim.
curiosity

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: COLORIZE FONT LISTVIEW ITEM

Post by HansV »

dtm is a Date variable - it does not depend on the user's date format. I got incorrect results with the String variable STRDATA (I use a different date format than you).
Best wishes,
Hans

User avatar
sal21
PlatinumLounger
Posts: 4334
Joined: 26 Apr 2010, 17:36

Re: COLORIZE FONT LISTVIEW ITEM

Post by sal21 »

HansV wrote:
28 Sep 2022, 20:49
dtm is a Date variable - it does not depend on the user's date format. I got incorrect results with the String variable STRDATA (I use a different date format than you).
ok underatand.

User avatar
SpeakEasy
4StarLounger
Posts: 536
Joined: 27 Jun 2021, 10:46

Re: COLORIZE FONT LISTVIEW ITEM

Post by SpeakEasy »

You could probably do away with all those Case statements with a single finely crafted If statement.