codice:
               
Private Sub CreaColonne(Rec As Recordset, Optional ByVal sSql As String)
   Dim i As Integer
   If Len(sSql) > 0 Then
      Rec.Open sSql
   Else
      Rec.Open
   End If
   For i = 1 To Rec.Fields.Count
      frmIntellilist.lblMisura.Caption = Rec.Fields(i - 1).Name
      frmIntellilist.lswIntel.ColumnHeaders.Add , , Rec.Fields(i - 1).Name, frmIntellilist.lblMisura.Width + 50
   Next i
   Rec.Close
End Sub
Private Sub CreaLinee(Rec As Recordset, Optional ByVal sSql As String)
   Dim mItem As ListItem
   Dim i As Integer
   If Len(sSql) > 0 Then
      Rec.Open sSql
   Else
      Rec.Open
   End If
   'Rec.MoveLast
   'Rec.MoveFirst
   frmIntellilist.proIntel.Min = 0
   frmIntellilist.proIntel.Max = (Rec.RecordCount + 0.001)
   Do Until Rec.EOF
      Set mItem = frmIntellilist.lswIntel.ListItems.Add(, , Rec.Fields(0).Value)
      For i = 1 To Rec.Fields.Count - 1
         If IsNull(Rec.Fields(i).Value) = False Then
            frmIntellilist.lblMisura.Caption = Rec.Fields(i).Value
         Else
            frmIntellilist.lblMisura.Caption = ""
         End If
         Debug.Print Rec.Fields(i).Name & frmIntellilist.lblMisura.Caption
         If frmIntellilist.lswIntel.ColumnHeaders(i).Width < (frmIntellilist.lblMisura.Width + 500) Then
            frmIntellilist.lswIntel.ColumnHeaders(i).Width = frmIntellilist.lblMisura.Width + 1000
         End If
         If IsNull(Rec.Fields(i).Value) = False Then
            mItem.ListSubItems.Add , , Rec.Fields(i).Value
         Else
            mItem.ListSubItems.Add , , ""
         End If
      Next i
      DoEvents
      Rec.MoveNext
      If frmIntellilist.proIntel.Value < frmIntellilist.proIntel.Max Then
         frmIntellilist.proIntel.Value = frmIntellilist.proIntel.Value + 1
      End If
      frmIntellilist.proIntel.Refresh
   Loop
   Rec.Close
End Sub
lblmisura è una label invisibile che metti con proprietà autosize = true e stesso font della lista
prointel è una progressbar