Galera,
Tenho a rotina abaixo para pintar as linhas do listview de acordo com uma condição:
Está ocorrendo algo estranho, quando eu acompanho a execução pelo F8 tudo é executado da maneira certa, quando abro o formulário dá errado.
Anexo os arquivos excel e access.
Alguem pode ajudar?
Private Sub UserForm_Initialize()
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim cx As New Classeconexao
Dim banco As ADODB.Recordset
Dim sql As String
On Error Resume Next
Set banco = New ADODB.Recordset
sql = " SELECT * FROM Tabela1 "
sql = sql & " WHERE Item1 = '" & "a" & "'"
cx.Conectar
Me.ListView1.View = lvwReport
Me.ListView1.Gridlines = True
Me.ListView1.ColumnHeaders.Add , , "Item 1"
Me.ListView1.ColumnHeaders.Add , , "Item 2"
Me.ListView1.ColumnHeaders.Add , , "Item 3"
Me.ListView1.ColumnHeaders(1).Width = 50
Me.ListView1.ColumnHeaders(2).Width = 50
Me.ListView1.ColumnHeaders(3).Width = 50
With banco
.CursorType = adOpenKeyset
.CursorLocation = adUseClient
.Source = sql
.ActiveConnection = cx.Conn
.Open
End With
Me.ListView1.FullRowSelect = True
Dim itens As ListItem
While Not banco.EOF
Set itens = Me.ListView1.ListItems.Add(, , banco(1))
itens.SubItems(1) = "" & banco(2)
itens.SubItems(2) = "" & banco(3)
If banco(3) = "c" Then
itens.ForeColor = vbBlue
For x = 0 To Me.ListView1.ColumnHeaders.Count - 1
Me.ListView1.ListItems(N).ListSubItems(x).ForeColor = vbBlue
Me.ListView1.ListItems(N).ForeColor = vbBlue
Me.ListView1.ListItems(N).ForeColor = vbBlue
Next
N = N + 1
ElseIf banco(3) = "a" Then
itens.ForeColor = vbGreen
For x = 0 To Me.ListView1.ColumnHeaders.Count - 1
Me.ListView1.ListItems(N).ListSubItems(x).ForeColor = vbGreen
Me.ListView1.ListItems(N).ForeColor = vbGreen
Me.ListView1.ListItems(N).ForeColor = vbGreen
Next
N = N + 1
Else
itens.ForeColor = vbRed
For x = 0 To Me.ListView1.ColumnHeaders.Count - 1
Me.ListView1.ListItems(N).ListSubItems(x).ForeColor = vbRed
Me.ListView1.ListItems(N).ForeColor = vbRed
Me.ListView1.ListItems(N).ForeColor = vbRed
Next
N = N + 1
End If
banco.MoveNext
Wend
cx.Desconectar
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Postado : 07/08/2013 7:35 am