Prezados (as),

Utilizo o código abaixo na listivew.

Eu preciso inserir um código que some a 8° coluna.

Alguém pode me ajudar?

Private Sub PopulaListBox(ByVal matrícula As String, _
ByVal empregado As String, _
ByVal cargo As String, _
ByVal setor As String, _
ByVal ccusto As String, _
ByVal alteração As String, _
ByVal motivo As String, _
ByVal observação As String, _
ByVal situação 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, cargo, setor, ccusto, alteração, motivo, observação, situação)

'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
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

Dim x As Integer
For x = 1 To lstLista.ListItems.Count
Me.lstLista.ListItems(x).SubItems(8) = Format(Me.lstLista.ListItems(x).SubItems(8), "currency")

Next

End Sub