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
Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Problema em atualizar status de todas as linhas de listview
- Reinaldo
- 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
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
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