MUDANDO A FONTE DO LISTVIEW
Meus amigos, sei que existem dezenas de códigos para essa função, porém nenhuma delas serviu, todas tem um pequeno erro de compilação e por aà vai, esse é o meu código:
[txt-color=#0000f0]Private Sub txtLNome_Change()
Dim item As ListItem
ListAlterar.ListItems.Clear
ConnectDB
rs.Open [Ô]Select * from tblCad where NOME like [ô][Ô] & txtLNome.Text & [Ô]%[ô][Ô], db, 3, 3
Do Until (rs.EOF)
Set item = ListAlterar.ListItems.Add(, , rs!cod)
item.SubItems(1) = [Ô][Ô] & rs!Nome
item.SubItems(2) = [Ô][Ô] & rs!CELULAR
item.SubItems(3) = [Ô][Ô] & rs!TELEFONE
item.SubItems(4) = [Ô][Ô] & rs!SIT [txt-color=#007100] [ô]Quero alterar a cor baseado nesse critério[/txt-color]
rs.MoveNext
Loop
Set rs = Nothing
db.Close: Set db = Nothing
End Sub
[/txt-color]
Eu que apenas que , se o campo[txt-color=#0000f0] rsSit = [Ô]S[Ô][/txt-color] que essa linha
fique Verde, se for [Ô]N[Ô] fique branca, [Ô]O[Ô] laranja e se for = [Ô]C[Ô] que a linha fique vermelha.
Sei que isso é algo simples mas não estou conseguindo.
[txt-color=#0000f0]Private Sub txtLNome_Change()
Dim item As ListItem
ListAlterar.ListItems.Clear
ConnectDB
rs.Open [Ô]Select * from tblCad where NOME like [ô][Ô] & txtLNome.Text & [Ô]%[ô][Ô], db, 3, 3
Do Until (rs.EOF)
Set item = ListAlterar.ListItems.Add(, , rs!cod)
item.SubItems(1) = [Ô][Ô] & rs!Nome
item.SubItems(2) = [Ô][Ô] & rs!CELULAR
item.SubItems(3) = [Ô][Ô] & rs!TELEFONE
item.SubItems(4) = [Ô][Ô] & rs!SIT [txt-color=#007100] [ô]Quero alterar a cor baseado nesse critério[/txt-color]
rs.MoveNext
Loop
Set rs = Nothing
db.Close: Set db = Nothing
End Sub
[/txt-color]
Eu que apenas que , se o campo[txt-color=#0000f0] rsSit = [Ô]S[Ô][/txt-color] que essa linha
fique Verde, se for [Ô]N[Ô] fique branca, [Ô]O[Ô] laranja e se for = [Ô]C[Ô] que a linha fique vermelha.
Sei que isso é algo simples mas não estou conseguindo.
tenta
testa ai num tenho certeza mas acho que vai funcionar
Private Sub txtLNome_Change()
Dim item As ListItem
ListAlterar.ListItems.Clear
ConnectDB
rs.Open [Ô]Select * from tblCad where NOME like [ô][Ô] & txtLNome.Text & [Ô]%[ô][Ô], db, 3, 3
Do Until (rs.EOF)
Set item = .ListItems.Add(, , rs!cod)
item.SubItems(1) = [Ô][Ô] & rs!Nome
item.SubItems(2) = [Ô][Ô] & rs!CELULAR
item.SubItems(3) = [Ô][Ô] & rs!TELEFONE
item.SubItems(4) = [Ô][Ô] & rs!SIT [txt-color=#007100] [ô]Quero alterar a cor baseado nesse critério
ListAlterar.ListItems(1).ListSubItems(1).ForeColor = IIf(rs!SIT = [Ô]S[Ô], vbGreen, IIF(rs!SIT = [Ô]N[Ô], vbWhite, IIF(rs!SIT = [Ô]O[Ô], vbOrange,IIF(rs!SIT = [Ô]C[Ô],vbRed, vbBlack)))))
rs.MoveNext
Loop
Set rs = Nothing
db.Close:
Set db = Nothing
End Sub
testa ai num tenho certeza mas acho que vai funcionar
Citação::
tentaPrivate Sub txtLNome_Change()
Dim item As ListItem
ListAlterar.ListItems.Clear
ConnectDB
rs.Open [Ô]Select * from tblCad where NOME like [ô][Ô] & txtLNome.Text & [Ô]%[ô][Ô], db, 3, 3
Do Until (rs.EOF)
Set item = .ListItems.Add(, , rs!cod)
item.SubItems(1) = [Ô][Ô] & rs!Nome
item.SubItems(2) = [Ô][Ô] & rs!CELULAR
item.SubItems(3) = [Ô][Ô] & rs!TELEFONE
item.SubItems(4) = [Ô][Ô] & rs!SIT [txt-color=#007100] [ô]Quero alterar a cor baseado nesse critério
ListAlterar.ListItems(1).ListSubItems(1).ForeColor = IIf(rs!SIT = [Ô]S[Ô], vbGreen, IIF(rs!SIT = [Ô]N[Ô], vbWhite, IIF(rs!SIT = [Ô]O[Ô], vbOrange,IIF(rs!SIT = [Ô]C[Ô],vbRed, vbBlack)))))
rs.MoveNext
Loop
Set rs = Nothing
db.Close:
Set db = Nothing
End Sub
testa ai num tenho certeza mas acho que vai funcionar
Marcelo, deu esse erro e esse
bom vamos lá colega faz o seguinte cola esta função publica no seu form
agora altere o seu código
veja agora se funciona
Public Sub ColorListviewRow(LV As ListView, RowNbr As Long, RowColor As OLE_COLOR)
Dim itmX As ListItem
Dim lvSI As ListSubItem
Dim intIndex As Integer
On Error GoTo ErrorRoutine
Set itmX = LV.ListItems(RowNbr)
itmX.ForeColor = RowColor
For intIndex = 1 To LV.ColumnHeaders.Count - 1
Set lvSI = itmX.ListSubItems(intIndex)
lvSI.ForeColor = RowColor
Next
Set itmX = Nothing
Set lvSI = Nothing
Exit Sub
ErrorRoutine:
MsgBox Err.Description
End Sub
agora altere o seu código
Dim item As ListItem
ListAlterar.ListItems.Clear
ConnectDB
rs.Open [Ô]Select * from tblCad where NOME like [ô][Ô] & txtLNome.Text & [Ô]%[ô][Ô], db, 3, 3
Do Until (rs.EOF)
Set item = .ListItems.Add(, , rs!cod)
item.SubItems(1) = [Ô][Ô] & rs!Nome
item.SubItems(2) = [Ô][Ô] & rs!CELULAR
item.SubItems(3) = [Ô][Ô] & rs!TELEFONE
item.SubItems(4) = [Ô][Ô] & rs!SIT [txt-color=#007100] [ô]Quero alterar a cor baseado nesse critério
rs.MoveNext
Loop
Set rs = Nothing
db.Close:
Set db = Nothing
With ListAlterar.ListItems
Dim coluna As String
For f = 1 To .Count - 1
coluna = ListAlterar.ListItems(f).ListSubItems(4).Text
Select Case coluna
Case [Ô]S[Ô]
ColorListviewRow ListAlterar, .Item(f).Index, vbGreen
Case [Ô]N[Ô]
ColorListviewRow ListAlterar, .Item(f).Index, vbWhite
Case [Ô]O[Ô]
ColorListviewRow ListAlterar, .Item(f).Index, &H80FF&
Case [Ô]C[Ô]
ColorListviewRow ListAlterar, .Item(f).Index, vbRed
End Select
Next f
End With
End Sub
veja agora se funciona
Marcelo, funcionou melhor que a encomenda, valeu mesmo, a muito tempo que procuro por isso,
só acrescentei um
[txt-color=#0000f0]Dim f as Integer[/txt-color]
antes do
[txt-color=#0000f0]For f = 1 To .Count [/txt-color][txt-color=#007100][ô]- 1 Aqui eu comentei este [Ô]-1[Ô] pois não estava alterando o último item[/txt-color]
Agora teria algum comando para ordenar por cores ao clicar em um item, tipo como ele ordena por ordem alfabética ele agruparia por cores
daà eu colocaria uma CheckBox para o usario escolher por ordem alfabética ou por cores o de ordem alfabética eu ja tenho.
Marcelo desde já obrigado pela sua força , se você não souber como agrupar por cores eu encerro este tópico e crio outro.
só acrescentei um
[txt-color=#0000f0]Dim f as Integer[/txt-color]
antes do
[txt-color=#0000f0]For f = 1 To .Count [/txt-color][txt-color=#007100][ô]- 1 Aqui eu comentei este [Ô]-1[Ô] pois não estava alterando o último item[/txt-color]
Agora teria algum comando para ordenar por cores ao clicar em um item, tipo como ele ordena por ordem alfabética ele agruparia por cores
daà eu colocaria uma CheckBox para o usario escolher por ordem alfabética ou por cores o de ordem alfabética eu ja tenho.
Marcelo desde já obrigado pela sua força , se você não souber como agrupar por cores eu encerro este tópico e crio outro.
Só uma pergunta se a cor é pela letra, então a ordem das cores não seria a mesma que as ordens alfabéticas?
porém se precisar mesmo posta o código que tem para ordenar por ordem alfabética pra ver se conseguimos altera-lo para cores
porém se precisar mesmo posta o código que tem para ordenar por ordem alfabética pra ver se conseguimos altera-lo para cores
Caramba Marcelo, dei uma de jumento agora, realmente se é pela letra então ele ordena as cores tb dã....mas aproveitando a oportunidade vou te apresentar o código que uso que só ordena os campos em texto, quando clico num campo com numeros ou datas ele mistura tudo:
[txt-color=#0000f0]
Private Sub ListAlterar_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
With ListAlterar
If (.Sorted) And (ColumnHeader.SubItemIndex = .SortKey) Then
If .SortOrder = lvwAscending Then
.SortOrder = lvwDescending
Else
.SortOrder = lvwAscending
End If
Else
.Sorted = True
.SortKey = ColumnHeader.SubItemIndex
.SortOrder = lvwAscending
End If
.Refresh
End With
If Not ListAlterar.SelectedItem Is Nothing Then
ListAlterar.SelectedItem.EnsureVisible
End If
End Sub [/txt-color]
Só preciso de um código que ordene tudo, quanto as cores ja ta resolvido.
[txt-color=#0000f0]
Private Sub ListAlterar_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
With ListAlterar
If (.Sorted) And (ColumnHeader.SubItemIndex = .SortKey) Then
If .SortOrder = lvwAscending Then
.SortOrder = lvwDescending
Else
.SortOrder = lvwAscending
End If
Else
.Sorted = True
.SortKey = ColumnHeader.SubItemIndex
.SortOrder = lvwAscending
End If
.Refresh
End With
If Not ListAlterar.SelectedItem Is Nothing Then
ListAlterar.SelectedItem.EnsureVisible
End If
End Sub [/txt-color]
Só preciso de um código que ordene tudo, quanto as cores ja ta resolvido.
colega mas é possÃvel ordenar pelo que vc quiser sem embaralhar
Usaremos o [Ô]Tag[Ô] de cada ColumHeader para armazenar
qual tipo de dados a coluna recebe:
= N para Números
= D para Datas
= T para Textos
como Fazer isso?
é simples no load do form, ou como no seu caso no change do textbox quando preenche o listview basta acrescentar as seguintes linha:
Não coloquei o D para campo data porque no casa não existe este campo data, mas se vc tiver em outro listview e so acrescentar na coluna a letra especifica.
acima coloquei apenas um trecho do código pois teremos outros mais.
bom feito isso acima agora você deverá colar em um MÓDULO o seguinte código:
e por fim você vai alterar a codificação que vc tem para ordernar para esta
pronto agora vc ira ordernar porque desejar, data, numeros textos
Boa sorte
Usaremos o [Ô]Tag[Ô] de cada ColumHeader para armazenar
qual tipo de dados a coluna recebe:
= N para Números
= D para Datas
= T para Textos
como Fazer isso?
é simples no load do form, ou como no seu caso no change do textbox quando preenche o listview basta acrescentar as seguintes linha:
Do Until (rs.EOF)
Set item = .ListItems.Add(, , rs!cod)
item.SubItems(1) = [Ô][Ô] & rs!Nome
item.SubItems(2) = [Ô][Ô] & rs!CELULAR
item.SubItems(3) = [Ô][Ô] & rs!TELEFONE
item.SubItems(4) = [Ô][Ô] & rs!SIT
rs.MoveNext
Loop
ListAlterar.ColumnHeaders(1).Tag = [Ô]T[Ô] [ô] coluna 1 onde esta o nome é por texto
ListAlterar.ColumnHeaders(2).Tag = [Ô]N[Ô]
ListAlterar.ColumnHeaders(3).Tag = [Ô]N[Ô] [ô] coluna 2 e 3 serão numeros
Não coloquei o D para campo data porque no casa não existe este campo data, mas se vc tiver em outro listview e so acrescentar na coluna a letra especifica.
acima coloquei apenas um trecho do código pois teremos outros mais.
bom feito isso acima agora você deverá colar em um MÓDULO o seguinte código:
Private Declare Function SendMessage Lib [Ô]user32[Ô] Alias [Ô]SendMessageA[Ô] (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function LockWindowUpdate Lib [Ô]user32[Ô] (ByVal hwndLock As Long) As Long
Public Sub SortListView(ListView As ListView, ByVal Index As Integer, _
ByVal DataType As ListDataType, ByVal Ascending As Boolean)
On Error Resume Next
Dim i As Integer
Dim l As Long
Dim strFormat As String
Dim lngCursor As Long
lngCursor = ListView.MousePointer
ListView.MousePointer = vbHourglass
LockWindowUpdate ListView.hwnd
Dim blnRestoreFromTag As Boolean
Select Case DataType
Case ldtString
blnRestoreFromTag = False
Case ldtNumber
strFormat = String$(20, [Ô]0[Ô]) & [Ô].[Ô] & String$(10, [Ô]0[Ô])
With ListView.ListItems
If (Index = 1) Then
For l = 1 To .Count
With .Item(l)
.Tag = .Text & Chr$(0) & .Tag
If IsNumeric(.Text) Then
If CDbl(.Text) >= 0 Then
.Text = Format(CDbl(.Text), strFormat)
Else
.Text = [Ô]&[Ô] & InvNumber(Format(0 - CDbl(.Text), strFormat))
End If
Else
.Text = [Ô][Ô]
End If
End With
Next l
Else
For l = 1 To .Count
With .Item(l).ListSubItems(Index - 1)
.Tag = .Text & Chr$(0) & .Tag
If IsNumeric(.Text) Then
If CDbl(.Text) >= 0 Then
.Text = Format(CDbl(.Text), strFormat)
Else
.Text = [Ô]&[Ô] & InvNumber(Format(0 - CDbl(.Text), strFormat))
End If
Else
.Text = [Ô][Ô]
End If
End With
Next l
End If
End With
blnRestoreFromTag = True
Case ldtDateTime
strFormat = [Ô]YYYYMMDDHhNnSs[Ô]
Dim dte As Date
With ListView.ListItems
If (Index = 1) Then
For l = 1 To .Count
With .Item(l)
.Tag = .Text & Chr$(0) & .Tag
dte = CDate(.Text)
.Text = Format$(dte, strFormat)
End With
Next l
Else
For l = 1 To .Count
With .Item(l).ListSubItems(Index - 1)
.Tag = .Text & Chr$(0) & .Tag
dte = CDate(.Text)
.Text = Format$(dte, strFormat)
End With
Next l
End If
End With
blnRestoreFromTag = True
End Select
ListView.SortOrder = IIf(Ascending, lvwAscending, lvwDescending)
ListView.SortKey = Index - 1
ListView.Sorted = True
If blnRestoreFromTag Then
With ListView.ListItems
If (Index = 1) Then
For l = 1 To .Count
With .Item(l)
i = InStr(.Tag, Chr$(0))
.Text = Left$(.Tag, i - 1)
.Tag = Mid$(.Tag, i + 1)
End With
Next l
Else
For l = 1 To .Count
With .Item(l).ListSubItems(Index - 1)
i = InStr(.Tag, Chr$(0))
.Text = Left$(.Tag, i - 1)
.Tag = Mid$(.Tag, i + 1)
End With
Next l
End If
End With
End If
LockWindowUpdate 0&
ListView.MousePointer = lngCursor
End Sub
e por fim você vai alterar a codificação que vc tem para ordernar para esta
Dim OrdAsc as boolean [ô]serve para poder classificar como ascendente/descendente
Private Sub ListAlterar_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
If ColumnHeader.Tag = [Ô]N[Ô] Then [ô]
SortListView ListAlterar, ColumnHeader.Index, ldtNumber, OrdAsc
ElseIf ColumnHeader.Tag = [Ô]T[Ô] Then
SortListView ListAlterar, ColumnHeader.Index, ldtString, OrdAsc
Else
SortListView ListAlterar, ColumnHeader.Index, ldtDateTime, True
End If
OrdAsc = Not OrdAsc
End Sub
pronto agora vc ira ordernar porque desejar, data, numeros textos
Boa sorte
Marcelo,
ta dando esse erro, qual objeto devo acrescentar?
ta dando esse erro, qual objeto devo acrescentar?
M4R10 eu achei um código postado em um fórum, onde muda a cor no listview.
Testei e foi de uma forma surpreendente.
Código pequeno e fácil de entender.
Caso queira posso colocar aqui.
Valeu.
Testei e foi de uma forma surpreendente.
Código pequeno e fácil de entender.
Caso queira posso colocar aqui.
Valeu.
Citação::
M4R10 eu achei um código postado em um fórum, onde muda a cor no listview.
Testei e foi de uma forma surpreendente.
Código pequeno e fácil de entender.
Caso queira posso colocar aqui.
Valeu.
Omar,
obrigado pela atenção, a cor do listview já foi resolvido mas aproveitei a ajuda do Marcelo e perguntei se tinha um código para ordenar o listview porque o que tenho só organiza as colunas com texto, então ele me passou este código que está na tela , ao inseri-lo deu o erro que postei acima, preciso apenas saber qual referencia devo acrescentar para que o código funcione.
Tópico encerrado , respostas não são mais permitidas