Prezados,
Utilizo o código abaixo para filtrar uma listview.
A 8° coluna refere-se ao total de horas de cada atestado. Exemplo: 16:00.
O que acontece é que, se a carga horária for maior que 23:59, a coluna apresenta as horas zeradas: 00:00:00
No final do filtro eu chamo o código que formata a coluna em horas, vide abaixo:
Sub FormatarColunahoras()
'Loop coluna
Dim X As Integer
For X = 1 To lstLista.ListItems.Count
lstLista.ListItems(X).ListSubItems(8).Text = Format(lstLista.ListItems(X).ListSubItems(8).Text, "hh:mm:ss")
Next
End Sub
O que devo fazer?
Código para Filtrar:
Private Sub PopulaListBox(ByVal matrícula As String, _
ByVal empregado As String, _
ByVal setor As String, _
ByVal cargo As String, _
ByVal atendimento As String, _
ByVal HOSPITAL As String, _
ByVal médico As String, _
ByVal motivo As String)
On Error GoTo TrataErro
Dim rst As ADODB.Recordset
Dim campo As Field
Dim myArray() As Variant
Dim i As Integer
Dim li As ListItem, fld As Field, ch As ColumnHeader
Dim Column As Long
Dim Counter As Long
Counter = 0
Set rst = PreecheRecordSet(matrícula, empregado, setor, cargo, atendimento, HOSPITAL, médico, motivo)
'preenche o combobox com os nomes dos campos
'persiste o índice
Dim indiceTemp As Long
indiceTemp = cboOrdenarPor.ListIndex
cboOrdenarPor.Clear
For Each campo In rst.Fields
cboOrdenarPor.AddItem campo.Name
Next
'recupera o índice selecionado
cboOrdenarPor.ListIndex = indiceTemp
'Colunas a Preencher Inicia na Primeira
For i = 0 To rst.Fields.Count - 1 'For i = 1 : a partir da 2ª coluna
Set ch = lstLista.ColumnHeaders.Add(, , rst.Fields(i).Name)
'ch.Width = 48 'Define o Tamanho de Todas as COLUNAS
'MsgBox rst.Fields(i).Name
Next
'Clear the Column Headers
lstLista.ListItems.Clear
'coloca as linhas do RecordSet num Array, se houver linhas neste
If Not rst.BOF Then
Do While Not rst.EOF
'Preenche o LISTVIEW a partir da 2ª Coluna
'Set li = lstLista.ListItems.Add(, "k" & rst.Fields(0), CheckNull(rst.Fields(1)))
'Fill in the rest of the columns
'For i = 2 To rst.Fields.Count - 1
'li.SubItems(i - 1) = CheckNull(rst.Fields(i))
'Preenche o LISTVIEW a partir da 1ª Coluna
Set li = lstLista.ListItems.Add(, "k" & rst.Fields(0), CheckNull(rst.Fields(0)))
'Fill in the rest of the columns
For i = 1 To rst.Fields.Count - 1
li.SubItems(i) = CheckNull(rst.Fields(i))
Next
rst.MoveNext 'Move to next record
Loop
'Define os Tamanhos das colunas automaticamente
Call TamanhoColAutomatico
'Formata Moeda
Call FormatarColunaMoeda
Call FormatarColunahoras
End If
'atualiza o label de mensagens
If rst.RecordCount <= 0 Then
lblMensagens.Caption = rst.RecordCount & " registros encontrados"
Else
lblMensagens.Caption = rst.RecordCount & " registros encontrados"
End If
Exit Sub
' Fecha o conjunto de registros.
Set rst = Nothing
' Fecha a conexão.
'conn.Close
TrataSaida:
Exit Sub
TrataErro:
Debug.Print Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
MsgBox Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
Resume TrataSaida
End Sub
Postado : 23/04/2014 8:34 am