Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Problema em atualizar status de todas as linhas de listview

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
Eumar
Acabou de chegar
Acabou de chegar
Mensagens: 1
Registrado em: Sex Mai 31, 2019 10:16 am

Problema em atualizar status de todas as linhas de listview

Mensagem por Eumar »

Fala galera, saudações!

Criei uma ferramenta para controle de vencimento de ASO dos funcionários da minha empresa. A ideia é que ao carregar a listview, seja comparada a data de validade (carregada do banco de dados) com a data de hoje.
Porém, tenho os seguintes problemas:
1) O status só é exibido quando a informação da linha anterior existe;
2) A verificação não corre todas as linhas da listview apesar de referenciar For x = 1 To ListView2.ListItems.Count

Segue código:

Private Sub UserForm_Initialize()

On Error Resume Next

Call ConfigurarListDados1

Call Conecta_BDFunc
Set RS = New ADODB.Recordset
RS.Open "SELECT * FROM BDFuncionarios", MiConexao, adOpenKeyset, adLockPessimistic, adCmdText

Me.ListView2.ListItems.Clear

While Not RS.EOF

Set List = Me.ListView2.ListItems.Add(Text:=RS(0))
List.SubItems(0) = RS(1) 'FUNCIONÁRIO
List.SubItems(1) = RS(34) 'ÚLTIMO ANUAL
List.SubItems(2) = RS(35) 'VENCIMENTO ANUAL
List.SubItems(3) = RS(36) 'STATUS ANUAL
List.SubItems(4) = RS(37) 'AGENDAMENTO ANUAL
List.SubItems(5) = RS(38) 'ÚLTIMO SEMESTRAL
List.SubItems(6) = RS(42) 'VENCIMENTO SEMESTRAL
List.SubItems(7) = RS(39) 'STATUS SEMESTRAL
List.SubItems(8) = RS(40) 'AGENDAMENTO SEMESTRAL
List.SubItems(9) = RS(14) 'email
List.SubItems(10) = RS(42) 'observação aso
List.SubItems(11) = RS(7) 'logradouro
List.SubItems(12) = RS(8) 'endereço
List.SubItems(13) = RS(13) 'cep
List.SubItems(14) = RS(12) 'cidade
List.SubItems(15) = RS(9) 'numero
List.SubItems(16) = RS(11) 'bairro
List.SubItems(17) = RS(10) 'complemento
List.SubItems(18) = "" 'RS(19)estado
List.SubItems(19) = RS(16) 'sispat

RS.MoveNext

Wend

Call Verifica_Status

Call Verifica_Status1

Call desconecta


End Sub

Sub Verifica_Status()
Dim x As Integer

'Loop cada linha na listview
For x = 1 To ListView2.ListItems.Count

If CDate(Me.ListView2.ListItems(x).ListSubItems(2)) - Date > 60 Then
Me.ListView2.ListItems(x).ListSubItems(3).Text = "ASO ANUAL DENTRO DO PRAZO"
Me.ListView2.ListItems(x).ListSubItems(3).ForeColor = vbWhite
ElseIf CDate(Me.ListView2.ListItems(x).ListSubItems(2)) < Date Then
Me.ListView2.ListItems(x).ListSubItems(3).Text = "ASO ANUAL VENCIDO"
Me.ListView2.ListItems(x).ListSubItems(3).ForeColor = vbRed
ElseIf CDate(Me.ListView2.ListItems(x).ListSubItems(2)) - Date <= 60 Then
Me.ListView2.ListItems(x).ListSubItems(3).Text = "AGENDAR ASO ANUAL"
Me.ListView2.ListItems(x).ListSubItems(3).ForeColor = vbBlack
ElseIf Me.ListView2.ListItems(x).ListSubItems(4) <> "" Then
Me.ListView2.ListItems(x).ListSubItems(3).Text = "ASO ANUAL AGENDADO"
Me.ListView2.ListItems(x).ListSubItems(3).ForeColor = vbYellow


End If
Next x
End Sub
Sub Verifica_Status1()
Dim y As Integer

For y = 1 To ListView2.ListItems.Count

If CDate(Me.ListView2.ListItems(y).ListSubItems(6)) - Date > 60 Then
Me.ListView2.ListItems(y).ListSubItems(7).Text = "ASO ANUAL DENTRO DO PRAZO"
Me.ListView2.ListItems(y).ListSubItems(7).ForeColor = vbWhite
ElseIf CDate(Me.ListView2.ListItems(y).ListSubItems(6)) < Date Then
Me.ListView2.ListItems(y).ListSubItems(7).Text = "ASO ANUAL VENCIDO"
Me.ListView2.ListItems(y).ListSubItems(7).ForeColor = vbRed
ElseIf CDate(Me.ListView2.ListItems(y).ListSubItems(6)) - Date <= 60 Then
Me.ListView2.ListItems(y).ListSubItems(7).Text = "AGENDAR ASO ANUAL"
Me.ListView2.ListItems(y).ListSubItems(7).ForeColor = vbBlack
ElseIf Me.ListView2.ListItems(y).ListSubItems(8) <> "" Then
Me.ListView2.ListItems(y).ListSubItems(7).Text = "ASO ANUAL AGENDADO"
Me.ListView2.ListItems(y).ListSubItems(7).ForeColor = vbYellow
End If
Next y

End Sub

Sub ConfigurarListDados1()
'Configurar o ListView - ListDados

Dim i As Integer

With ListView2
.View = lvwReport
.FullRowSelect = True
'.MultiSelect = True
.CheckBoxes = False
.LabelEdit = lvwManual
.HideColumnHeaders = False
.Gridlines = True
Call Conecta_BDFunc

Set RS = New ADODB.Recordset
RS.Open "SELECT * FROM BDFuncionarios", MiConexao, adOpenKeyset, adLockOptimistic, adCmdText
'For i = 1 To RS.Fields.Count - 1
.ColumnHeaders.Add Text:="FUNCIONÁRIO", Width:=200
.ColumnHeaders.Add Text:="ÚLTIMO ANUAL", Width:=90, Alignment:=2
.ColumnHeaders.Add Text:="VENCIMENTO ANUAL", Width:=90, Alignment:=2
.ColumnHeaders.Add Text:="STATUS ANUAL", Width:=90, Alignment:=0
.ColumnHeaders.Add Text:="AGENDAMENTO ANUAL", Width:=90, Alignment:=0
.ColumnHeaders.Add Text:="ÚLTIMO SEMESTRAL", Width:=90, Alignment:=2
.ColumnHeaders.Add Text:="VENCIMENTO SEMESTRAL", Width:=90, Alignment:=2
.ColumnHeaders.Add Text:="STATUS SEMESTRAL", Width:=90, Alignment:=0
.ColumnHeaders.Add Text:="AGENDAMENTO SEMESTRAL", Width:=100, Alignment:=0
.ColumnHeaders.Add Text:="E-MAIL", Width:=100, Alignment:=2
.ColumnHeaders.Add Text:="OBSERVAÇÃO", Width:=200, Alignment:=2
.ColumnHeaders.Add Text:="LOGRADOURO", Width:=25, Alignment:=0
.ColumnHeaders.Add Text:="ENDEREÇO", Width:=60, Alignment:=0
.ColumnHeaders.Add Text:="CEP", Width:=30, Alignment:=0
.ColumnHeaders.Add Text:="CIDADE", Width:=50, Alignment:=0
.ColumnHeaders.Add Text:="NUMERO", Width:=20, Alignment:=0
.ColumnHeaders.Add Text:="BAIRRO", Width:=30, Alignment:=0
.ColumnHeaders.Add Text:="COMPLEMENTO", Width:=50, Alignment:=0
.ColumnHeaders.Add Text:="ESTADO", Width:=50, Alignment:=0
.ColumnHeaders.Add Text:="SISPAT", Width:=30, Alignment:=0
'.ColumnHeaders.Add Text:="OBSERVAÇÃO", Width:=10, Alignment:=0
'.ColumnHeaders.Add 1, , RS("FUNCIONÁRIO").Name
'.ColumnHeaders.Add 2, , RS("ÚLTIMO ASO").Name
'.ColumnHeaders.Add 3, , RS("DATA DO ÚLTIMO ASO").Name
'.ColumnHeaders.Add 4, , RS("PRÓXIMO ASO").Name
'.ColumnHeaders.Add 5, , RS("VENCIMENTO").Name
'.ColumnHeaders.Add 6, , RS("STATUS").Name
'Next
Call desconecta
End With

End Sub


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
Reinaldo
Jedi
Jedi
Mensagens: 1537
Registrado em: Sex Ago 01, 2014 4:09 pm
Localização: Garça - SP / SCS - SP

Re: Problema em atualizar status de todas as linhas de listview

Mensagem por Reinaldo »

Apenas pela rotina e descrição ofertada fica muito difícil, saber/propor alterações/correções.

Monte um modelo, com alguns registros (fictícios) que sejam representativos da estrutura/tipodedados e problemas encontrados; para que os interessados possam tentar lhe auxiliar com mais propriedade


Responder