LinkBack URL
About LinkBacksHi,
I would like to color 1 line over 2 in my listview.
till now i've just found how to color font of its items, but not row by
itself.
is it possible to color rows of a Listview component ?
if yes, how ?
thx,
Maileen
Hi,
I would like to color 1 line over 2 in my listview.
till now i've just found how to color font of its items, but not row by
itself.
is it possible to color rows of a Listview component ?
if yes, how ?
thx,
Maileen
You can't format the individual items in the list.
--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
"Maileen" <nospam@email.com> wrote in message
news:eHIshUx%23EHA.3336@TK2MSFTNGP11.phx.gbl...
> Hi,
>
> I would like to color 1 line over 2 in my listview.
> till now i've just found how to color font of its items, but
> not row by itself.
>
> is it possible to color rows of a Listview component ?
> if yes, how ?
> thx,
>
> Maileen
If you want to colour all of the listitems, do a search for: Const
LVM_SETTEXTBKCOLOR
I dont know of a way to colour individual rows
--
Rob van Gelder - http://www.vangelder.co.nz/excel
"Maileen" <nospam@email.com> wrote in message
news:eHIshUx%23EHA.3336@TK2MSFTNGP11.phx.gbl...
> Hi,
>
> I would like to color 1 line over 2 in my listview.
> till now i've just found how to color font of its items, but not row by
> itself.
>
> is it possible to color rows of a Listview component ?
> if yes, how ?
> thx,
>
> Maileen
Hi Maileen;
You can try this for demo.
Place a listview on an userform and:
In UserForm module:
Option Explicit
Private Declare Function SetWindowLong& Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long _
, ByVal wCmd As Long) As Long
Private Const GWL_WNDPROC As Long = (-4&)
Private hWnd As Long
Private Sub UserForm_Initialize()
Dim i&
hWnd = GetWindow(FindWindow(vbNullString, Me.Caption), 5)
With Me.ListView1
..ColumnHeaders.Add , , "Item Column", .Width * 1 / 3
..ColumnHeaders.Add , , "Subitem 1", .Width * 1 / 3
..ColumnHeaders.Add , , "Subitem 2", .Width * 1 / 3
For i = 0 To 99
With .ListItems.Add(, , "Item " & Format(i, "00"))
..SubItems(1) = "Subitem 1"
..SubItems(2) = "Subitem 2"
End With
Next
End With
OldProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Call SetWindowLong(hWnd, GWL_WNDPROC, OldProc)
End Sub
In standard module:
Option Explicit
' Constants used for customdraw routine
Private Const NM_CUSTOMDRAW = (-12&)
Private Const WM_NOTIFY As Long = &H4E&
Private Const CDDS_PREPAINT As Long = &H1&
Private Const CDRF_NOTIFYITEMDRAW As Long = &H20&
Private Const CDDS_ITEM As Long = &H10000
Private Const CDDS_ITEMPREPAINT As Long = CDDS_ITEM Or CDDS_PREPAINT
Private Const CDRF_NEWFONT As Long = &H2&
' The NMHDR structure contains information about a notification message.
' The pointer to this structure is specified as the lParam member of a
WM_NOTIFY message.
Private Type NMHDR
hWndFrom As Long ' Window handle of control sending message
idFrom As Long ' Identifier of control sending message
code As Long ' Specifies the notification code
End Type
' Struct of the NMCUSTOMDRAW struct
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
' Generic customdraw struct
Private Type NMCUSTOMDRAW
hdr As NMHDR
dwDrawStage As Long
hDC As Long
rc As RECT
dwItemSpec As Long
uItemState As Long
lItemlParam As Long
End Type
' Listview specific customdraw struct
Private Type NMLVCUSTOMDRAW
NMCW As NMCUSTOMDRAW
ForeColorText As Long
BackColorText As Long
' if IE >= 4.0 this member of the struct can be used
'iSubItem As Integer
End Type
' Function used to manipulate memory data
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(lpDest As Any, lpSource As Any, ByVal cBytes&)
' Function used to call the next window proc in the "chain" for the
subclassed window
Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc&, ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal
lParam&)
' This var will hold a pointer to the original message handler so we MUST
' save it so that it can be restored before we exit the app. if we don't
' restore it.... CRASH!!!!
Public OldProc As Long
' WARNING -----------------------------------------------
' Do not try to step through this function in debug mode !
' You will crash also, do no set any break points in this function !
' You will crash subclassing is non-trivial and should be handled with
' extreame care !
' There are ways to use a "Debug" dll to allow you to set breakpoints in
' subclassed code in the IDE but this was not implimented for this demo.
' WARNING -----------------------------------------------
' This is implementation of the message handling routine
' determine which message was recieved
Function WindowProc(ByVal hWnd As Long, ByVal iMsg As Long _
, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case iMsg
Case WM_NOTIFY
' If it's a WM_NOTIFY message copy the data from the
' address pointed to by lParam into a NMHDR struct
Dim UDT_NMHDR As NMHDR
CopyMemory UDT_NMHDR, ByVal lParam, 12&
With UDT_NMHDR
If .code = NM_CUSTOMDRAW Then
' If the code member of the struct is NM_CUSTOMDRAW, copy
' the data pointed to by lParam into a NMLVCUSTOMDRAW struct
Dim UDT_NMLVCUSTOMDRAW As NMLVCUSTOMDRAW
' This is now OUR copy of the struct
CopyMemory UDT_NMLVCUSTOMDRAW, ByVal lParam, Len(UDT_NMLVCUSTOMDRAW)
With UDT_NMLVCUSTOMDRAW.NMCW
' Determine whether or not this is one of the messages we are interested in
Select Case .dwDrawStage
' If it's a prepaint message, tell windows WE want first dibs on
' painting for each item and then exit without letting VB get this message
Case CDDS_PREPAINT
WindowProc = CDRF_NOTIFYITEMDRAW
Exit Function
Case CDDS_ITEMPREPAINT
' Set the forecolor for items in the listview.
' Set the backcolor for items in the listview.
If (.dwItemSpec Mod 2) = 0 Then
UDT_NMLVCUSTOMDRAW.ForeColorText = vbRed
UDT_NMLVCUSTOMDRAW.BackColorText = &HC0C0C0
' Copy our copy of the struct back to the memory address pointed to by
lParam
CopyMemory ByVal lParam, UDT_NMLVCUSTOMDRAW, Len(UDT_NMLVCUSTOMDRAW)
End If
' Tell windows that we changed the font and do not allow VB to get this
message
WindowProc = CDRF_NEWFONT
Exit Function
End Select
End With
End If
End With
End Select
' Pass all messages on to VB and then return the value to windows
WindowProc = CallWindowProc(OldProc, hWnd, iMsg, wParam, lParam)
End Function
Sub CustomListView()
UserForm1.Show
End Sub
Regards,
MP
"Maileen" <nospam@email.com> a écrit dans le message de
news:eHIshUx%23EHA.3336@TK2MSFTNGP11.phx.gbl...
> Hi,
>
> I would like to color 1 line over 2 in my listview.
> till now i've just found how to color font of its items, but not row by
> itself.
>
> is it possible to color rows of a Listview component ?
> if yes, how ?
> thx,
>
> Maileen
Michel,
Hooking the WinProc event handler... Now that's impressive.
--
Rob van Gelder - http://www.vangelder.co.nz/excel
"Michel Pierron" <michel.pierron@free.fr> wrote in message
news:eff87e8%23EHA.1264@TK2MSFTNGP12.phx.gbl...
> Hi Maileen;
> You can try this for demo.
> Place a listview on an userform and:
> In UserForm module:
>
> Option Explicit
> Private Declare Function SetWindowLong& Lib "user32" Alias _
> "SetWindowLongA" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
> Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
> (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
> Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long _
> , ByVal wCmd As Long) As Long
> Private Const GWL_WNDPROC As Long = (-4&)
> Private hWnd As Long
>
> Private Sub UserForm_Initialize()
> Dim i&
> hWnd = GetWindow(FindWindow(vbNullString, Me.Caption), 5)
> With Me.ListView1
> .ColumnHeaders.Add , , "Item Column", .Width * 1 / 3
> .ColumnHeaders.Add , , "Subitem 1", .Width * 1 / 3
> .ColumnHeaders.Add , , "Subitem 2", .Width * 1 / 3
> For i = 0 To 99
> With .ListItems.Add(, , "Item " & Format(i, "00"))
> .SubItems(1) = "Subitem 1"
> .SubItems(2) = "Subitem 2"
> End With
> Next
> End With
> OldProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
> End Sub
>
> Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
> Call SetWindowLong(hWnd, GWL_WNDPROC, OldProc)
> End Sub
>
> In standard module:
> Option Explicit
> ' Constants used for customdraw routine
> Private Const NM_CUSTOMDRAW = (-12&)
> Private Const WM_NOTIFY As Long = &H4E&
> Private Const CDDS_PREPAINT As Long = &H1&
> Private Const CDRF_NOTIFYITEMDRAW As Long = &H20&
> Private Const CDDS_ITEM As Long = &H10000
> Private Const CDDS_ITEMPREPAINT As Long = CDDS_ITEM Or CDDS_PREPAINT
> Private Const CDRF_NEWFONT As Long = &H2&
>
> ' The NMHDR structure contains information about a notification message.
> ' The pointer to this structure is specified as the lParam member of a
> WM_NOTIFY message.
> Private Type NMHDR
> hWndFrom As Long ' Window handle of control sending message
> idFrom As Long ' Identifier of control sending message
> code As Long ' Specifies the notification code
> End Type
>
> ' Struct of the NMCUSTOMDRAW struct
> Private Type RECT
> Left As Long
> Top As Long
> Right As Long
> Bottom As Long
> End Type
>
> ' Generic customdraw struct
> Private Type NMCUSTOMDRAW
> hdr As NMHDR
> dwDrawStage As Long
> hDC As Long
> rc As RECT
> dwItemSpec As Long
> uItemState As Long
> lItemlParam As Long
> End Type
>
> ' Listview specific customdraw struct
> Private Type NMLVCUSTOMDRAW
> NMCW As NMCUSTOMDRAW
> ForeColorText As Long
> BackColorText As Long
> ' if IE >= 4.0 this member of the struct can be used
> 'iSubItem As Integer
> End Type
>
> ' Function used to manipulate memory data
> Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
> (lpDest As Any, lpSource As Any, ByVal cBytes&)
> ' Function used to call the next window proc in the "chain" for the
> subclassed window
> Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" _
> (ByVal lpPrevWndFunc&, ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal
> lParam&)
> ' This var will hold a pointer to the original message handler so we MUST
> ' save it so that it can be restored before we exit the app. if we don't
> ' restore it.... CRASH!!!!
> Public OldProc As Long
>
> ' WARNING -----------------------------------------------
> ' Do not try to step through this function in debug mode !
> ' You will crash also, do no set any break points in this function !
> ' You will crash subclassing is non-trivial and should be handled with
> ' extreame care !
> ' There are ways to use a "Debug" dll to allow you to set breakpoints in
> ' subclassed code in the IDE but this was not implimented for this demo.
> ' WARNING -----------------------------------------------
>
> ' This is implementation of the message handling routine
> ' determine which message was recieved
> Function WindowProc(ByVal hWnd As Long, ByVal iMsg As Long _
> , ByVal wParam As Long, ByVal lParam As Long) As Long
> Select Case iMsg
> Case WM_NOTIFY
> ' If it's a WM_NOTIFY message copy the data from the
> ' address pointed to by lParam into a NMHDR struct
> Dim UDT_NMHDR As NMHDR
> CopyMemory UDT_NMHDR, ByVal lParam, 12&
> With UDT_NMHDR
> If .code = NM_CUSTOMDRAW Then
> ' If the code member of the struct is NM_CUSTOMDRAW, copy
> ' the data pointed to by lParam into a NMLVCUSTOMDRAW struct
> Dim UDT_NMLVCUSTOMDRAW As NMLVCUSTOMDRAW
> ' This is now OUR copy of the struct
> CopyMemory UDT_NMLVCUSTOMDRAW, ByVal lParam, Len(UDT_NMLVCUSTOMDRAW)
> With UDT_NMLVCUSTOMDRAW.NMCW
> ' Determine whether or not this is one of the messages we are interested
> in
> Select Case .dwDrawStage
> ' If it's a prepaint message, tell windows WE want first dibs on
> ' painting for each item and then exit without letting VB get this message
> Case CDDS_PREPAINT
> WindowProc = CDRF_NOTIFYITEMDRAW
> Exit Function
> Case CDDS_ITEMPREPAINT
> ' Set the forecolor for items in the listview.
> ' Set the backcolor for items in the listview.
> If (.dwItemSpec Mod 2) = 0 Then
> UDT_NMLVCUSTOMDRAW.ForeColorText = vbRed
> UDT_NMLVCUSTOMDRAW.BackColorText = &HC0C0C0
> ' Copy our copy of the struct back to the memory address pointed to by
> lParam
> CopyMemory ByVal lParam, UDT_NMLVCUSTOMDRAW, Len(UDT_NMLVCUSTOMDRAW)
> End If
> ' Tell windows that we changed the font and do not allow VB to get this
> message
> WindowProc = CDRF_NEWFONT
> Exit Function
> End Select
> End With
> End If
> End With
> End Select
> ' Pass all messages on to VB and then return the value to windows
> WindowProc = CallWindowProc(OldProc, hWnd, iMsg, wParam, lParam)
> End Function
>
> Sub CustomListView()
> UserForm1.Show
> End Sub
>
> Regards,
> MP
>
> "Maileen" <nospam@email.com> a écrit dans le message de
> news:eHIshUx%23EHA.3336@TK2MSFTNGP11.phx.gbl...
>> Hi,
>>
>> I would like to color 1 line over 2 in my listview.
>> till now i've just found how to color font of its items, but not row by
>> itself.
>>
>> is it possible to color rows of a Listview component ?
>> if yes, how ?
>> thx,
>>
>> Maileen
>
Hi Rob,
> Hooking the WinProc event handler... Now that's impressive.
... and *very* dangerous in an interpreted environment! Save regularly!
Regards
Stephen Bullen
Microsoft MVP - Excel
www.oaltd.co.uk
Stephen Bullen wrote:
> > Hooking the WinProc event handler... Now that's impressive.
>
> .. and *very* dangerous in an interpreted environment! Save regularly!
>
> Regards
>
> Stephen Bullen
I think it looks impressive too, but for me crashes every time! Despite
fully heeding all safety warnings. VBE closed (no breaks), running from
Alt-F8, xl2k/w98se.
Regards,
Peter T
It worked for me just fine - XL2003
Some of the line wrapping on that post screwed me up.
There was one that I missed were the line contained the word Message. It was
accepted without error by VBA, but was in fact a comment from the previous
line.
--
Rob van Gelder - http://www.vangelder.co.nz/excel
"Peter T" <peter_t@discussions> wrote in message
news:eZRY$1H$EHA.2584@TK2MSFTNGP09.phx.gbl...
> Stephen Bullen wrote:
>> > Hooking the WinProc event handler... Now that's impressive.
>>
>> .. and *very* dangerous in an interpreted environment! Save regularly!
>>
>> Regards
>>
>> Stephen Bullen
>
> I think it looks impressive too, but for me crashes every time! Despite
> fully heeding all safety warnings. VBE closed (no breaks), running from
> Alt-F8, xl2k/w98se.
>
> Regards,
> Peter T
>
>
Rob van Gelder wrote:
> It worked for me just fine - XL2003
>
> Some of the line wrapping on that post screwed me up.
> There was one that I missed were the line contained the word Message. It
was
> accepted without error by VBA, but was in fact a comment from the previous
> line.
Hi Rob,
I'm very pleased you made me have another look. I thought I had carefully
"un line wrapped". I caught the line ending in "Message" which as you say
did not glow red. But there was another one I missed - lParam at the end of
the commented line starting "Copy our copy". After removing the stray
"lParam" all works fine.
Michel - please accept my apologies for casting aspersions on your amazing
code!!
I hope you will not mind if I take the liberty of reposting your code,
exactly as original but (hopefully) without any line wrapping.
Regards,
Peter T
Michel Pierron's code:
In UserForm module:
'''start code Userform
Option Explicit
Private Declare Function SetWindowLong& Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long _
, ByVal wCmd As Long) As Long
Private Const GWL_WNDPROC As Long = (-4&)
Private hWnd As Long
Private Sub UserForm_Initialize()
Dim i&
hWnd = GetWindow(FindWindow(vbNullString, Me.Caption), 5)
With Me.ListView1
..ColumnHeaders.Add , , "Item Column", .Width * 1 / 3
..ColumnHeaders.Add , , "Subitem 1", .Width * 1 / 3
..ColumnHeaders.Add , , "Subitem 2", .Width * 1 / 3
For i = 0 To 99
With .ListItems.Add(, , "Item " & Format(i, "00"))
..SubItems(1) = "Subitem 1"
..SubItems(2) = "Subitem 2"
End With
Next
End With
OldProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, _
CloseMode As Integer)
Call SetWindowLong(hWnd, GWL_WNDPROC, OldProc)
End Sub
'''end code Userform
In standard module:
''''''start code standard module
Option Explicit
' Constants used for customdraw routine
Private Const NM_CUSTOMDRAW = (-12&)
Private Const WM_NOTIFY As Long = &H4E&
Private Const CDDS_PREPAINT As Long = &H1&
Private Const CDRF_NOTIFYITEMDRAW As Long = &H20&
Private Const CDDS_ITEM As Long = &H10000
Private Const CDDS_ITEMPREPAINT As Long = CDDS_ITEM Or CDDS_PREPAINT
Private Const CDRF_NEWFONT As Long = &H2&
' The NMHDR structure contains information about a
' notification message.
' The pointer to this structure is specified as the lParam member of
'a WM_NOTIFY message.
Private Type NMHDR
hWndFrom As Long ' Window handle of control sending message
idFrom As Long ' Identifier of control sending message
code As Long ' Specifies the notification code
End Type
' Struct of the NMCUSTOMDRAW struct
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
' Generic customdraw struct
Private Type NMCUSTOMDRAW
hdr As NMHDR
dwDrawStage As Long
hDC As Long
rc As RECT
dwItemSpec As Long
uItemState As Long
lItemlParam As Long
End Type
' Listview specific customdraw struct
Private Type NMLVCUSTOMDRAW
NMCW As NMCUSTOMDRAW
ForeColorText As Long
BackColorText As Long
' if IE >= 4.0 this member of the struct can be used
'iSubItem As Integer
End Type
' Function used to manipulate memory data
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(lpDest As Any, lpSource As Any, ByVal cBytes&)
' Function used to call the next window proc in the "chain" for the
' subclassed Window
Declare Function CallWindowProc& Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc&, ByVal hWnd&, _
ByVal Msg&, ByVal wParam&, ByVal lParam&)
' This var will hold a pointer to the original message handler
' so we MUST save it so that it can be restored before we
' exit the app.
' if we don't restore it.... CRASH!!!!
Public OldProc As Long
' WARNING -----------------------------------------------
' Do not try to step through this function in debug mode !
' You will crash also, do no set any break points in this function !
' You will crash subclassing is non-trivial and should be handled with
' extreame care !
'There are ways to use a "Debug" dll to allow you to set breakpoints in
' subclassed code in the IDE but this was not implimented for this demo.
' WARNING -----------------------------------------------
' This is implementation of the message handling routine
' determine which message was recieved
Function WindowProc(ByVal hWnd As Long, ByVal iMsg As Long _
, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case iMsg
Case WM_NOTIFY
' If it's a WM_NOTIFY message copy the data from the
' address pointed to by lParam into a NMHDR struct
Dim UDT_NMHDR As NMHDR
CopyMemory UDT_NMHDR, ByVal lParam, 12&
With UDT_NMHDR
If .code = NM_CUSTOMDRAW Then
' If the code member of the struct is NM_CUSTOMDRAW, copy
' the data pointed to by lParam into a NMLVCUSTOMDRAW struct
Dim UDT_NMLVCUSTOMDRAW As NMLVCUSTOMDRAW
' This is now OUR copy of the struct
CopyMemory UDT_NMLVCUSTOMDRAW, ByVal lParam, Len(UDT_NMLVCUSTOMDRAW)
With UDT_NMLVCUSTOMDRAW.NMCW
' Determine whether or not this is one of the messages we are
' interested in
Select Case .dwDrawStage
' If it's a prepaint message, tell windows WE want first dibs on
' painting for each item and then exit without letting VB get
' this message
Case CDDS_PREPAINT
WindowProc = CDRF_NOTIFYITEMDRAW
Exit Function
Case CDDS_ITEMPREPAINT
' Set the forecolor for items in the listview.
' Set the backcolor for items in the listview.
If (.dwItemSpec Mod 2) = 0 Then
UDT_NMLVCUSTOMDRAW.ForeColorText = vbRed
UDT_NMLVCUSTOMDRAW.BackColorText = &HC0C0C0
' Copy our copy of the struct back to the memory address pointed
' to by lParam
CopyMemory ByVal lParam, UDT_NMLVCUSTOMDRAW, Len(UDT_NMLVCUSTOMDRAW)
End If
' Tell windows that we changed the font and do not allow VB to
' get this Message
WindowProc = CDRF_NEWFONT
Exit Function
End Select
End With
End If
End With
End Select
' Pass all messages on to VB and then return the value to windows
WindowProc = CallWindowProc(OldProc, hWnd, iMsg, wParam, lParam)
End Function
Sub CustomListView()
UserForm1.Show
End Sub
''''''end code standard module
invalid outside procedure error on this
Select Case iMsg
Teach me Excel VBA
This thread is 16 years old ...
Ali
Enthusiastic self-taught user of MS Excel who's always learning!
Don't forget to say "thank you" in your thread to anyone who has offered you help. It's a universal courtesy.
You can reward them by clicking on * Add Reputation below their user name on the left, if you wish.
NB: as a Moderator, I never accept friendship requests.
Forum Rules (updated August 2023): please read them here.
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
Register To Reply
Bookmarks