Sub Tampildata(X As String, ls As ListView, db As ADODB.Connection, icon As Integer)
On Error Resume Next
Dim pList As ListItem
Dim pJudul As ColumnHeaders
Dim Rs As ADODB.Recordset
Dim Jr As Integer
Dim Total As Currency
Set Rs = New ADODB.Recordset
Dim I, j, Baris, jKolom As Integer
Rs.Open X, db, adOpenDynamic, adLockReadOnly
ls.View = lvwReport
ls.FullRowSelect = True
ls.GridLines = True
ls.AllowColumnReorder = True
ls.ColumnHeaders.Clear
ls.ListItems.Clear
If Not Rs.EOF Then
Jr = Rs.RecordCount
Rs.MoveFirst
jKolom = Rs.Fields.Count
For I = 0 To jKolom - 1
ls.ColumnHeaders.Add , , Rs.Fields(I).Name
If IsAngkaNumerik(Trim(Rs.Fields(I).Type)) = True Then
ls.ColumnHeaders.Item(I + 1).Alignment = lvwColumnRight
End If
If IsAngkaNumerik(Trim(Rs.Fields(I).Type)) = False Then
ls.ColumnHeaders.Item(I + 1).Alignment = lvwColumnLeft
End If
Next I
ls.ColumnHeaders.Item(I + 1).Alignment = lvwColumnLeft
Baris = 0
Total = 0
While Not Rs.EOF
Total = 0
Baris = Baris + 1
Set pList = ls.ListItems.Add(, , Rs.Fields(0), , icon)
For I = 0 To jKolom - 1
If ls.ColumnHeaders.Item(I + 1).Alignment = lvwColumnRight Then
If Rs.Fields(I) < 1 Then
pList.SubItems(I) = 0
Else
pList.SubItems(I) = Format(Rs.Fields(I), "###,###,###,###")
End If
Else
pList.SubItems(I) = Rs.Fields(I)
End If
Next I
Rs.MoveNext
Wend
End If
End Sub
Function getItemList(ls As ListView, col As Integer) As String
On Error Resume Next
col = col - 1
If col = 0 Then
getItemList = ls.SelectedItem.Text
Else
getItemList = ls.SelectedItem.ListSubItems(col)
End If
End Function
Cara penggunaannya
xSQL = "Select * From Nama Tabel "
Tampildata xSQL, ms, Mydb, 1
Me.ms.ColumnHeaders.Item(2).Width = 2000

Program yang bagus
BalasHapus