Public Sub CargarListView(LV As ListView, rs As ADODB.Recordset, Campos As Integer)
Dim i As Long
Dim Columna As Integer
Dim X As Integer, Y As Integer
Dim Ancho As Long
LV.Sorted = False
On Error GoTo ErrorSub
With LV
.Refresh
.ListItems.Clear ' elimina todos los datos
.ColumnHeaders.Clear ' elimina los encabezados
.View = lvwReport 'vista de reporte
'.FlatScrollBar = True 'si la barra de desplazamiento aparece plana
.FullRowSelect = True 'determina si al seleccionar un elemento en la vista detalle, se selecciona la fila completamente
.GridLines = True 'linea en las filas y columnas
.HideSelection = False 'si el elemento seleccionado se mostrara como seleccionado cuando el listview pierde enfoque
.LabelEdit = lvwManual 'si un usuario puede modificar la etiqueta listitem o node
.BorderStyle = ccNone 'estilo de bordes
.Font.Name = "Verdana" 'fondo de letra verdana
.Font.Size = 8 'tamaño de la letra
.Appearance = ccFlat 'apariencia 3d
.TabStop = False ' si se usara tab para desplazarce
.ForeColor = vbBlack ' color de la letra
End With
' recorre los campos del recordset _
para crear las columnas en el Listview
'For Columna = 0 To rs.Fields.Count - 1
For Columna = 0 To Campos
X = rs(Columna).DefinedSize
Y = Len(rs(Columna).Name)
If Campos > 0 Then
If X > Y Then
If X = 10 Then X = X + 1
If X = 36 Then X = X - 4
Ancho = (X * 120)
Else
Y = Y + 2
Ancho = (Y * 120)
End If
Else
Ancho = LV.Width - 259
End If
If Columna = Campos Then
'LV.ColumnHeaders.Add , , UCase(rs(Columna).Name), 3850
LV.ColumnHeaders.Add , , UCase(rs(Columna).Name), LV.Width
Else
LV.ColumnHeaders.Add , , UCase(rs(Columna).Name), Ancho
End If
'AutosizeColumns LV
'Call ShowScrollBar(LV.hWnd, SB_HORZ, False)
Next
' si hay registros
If rs.RecordCount > 0 Then
' Recorre el conjunto de registros para añadir los items
While Not rs.EOF
' Item
Set objitem = LV.ListItems.Add(, , rs(0))
' subitems
For i = 1 To LV.ColumnHeaders.Count - 1
' verifica que el valor no sea un Null
If IsNull(rs.Fields(i).value) = False Then
objitem.SubItems(i) = rs.Fields(i).value
End If
Next
' Mueve al siguiente registro
rs.MoveNext
Wend
End If
'limpia el LV
'LV.ListItems.Clear
'Call ForeColorColumn(&H8000&, 0, Registro.LV)
'Call ForeColorColumn(vbRed, 1, Registro.LV)
Exit Sub
ErrorSub:
If Err.Number = 94 Then Resume Next
End Sub
