Excel VBA - How to remove the extra column in ListView

Question

Dear All,

I'm using a ListView to store the data of a recordset I have created.

Everything is working fine but I noticed I got an extra column at the end (see the red selection in the first below image):

Any way to remove it?

Any property can it be set?

This is the actual behavior:

What I need:

Thanks

Answer 1

Looking closer at that picture, I don't think that is a column at all, I think your control is wider than your total column widths.

Answer 2

Please post the code you use to populate the listview.

Answer 3

Here my code:

Sub ShowConnectedUser(LvwView As ListView, DBPath As String)
    Dim i As Integer
    Dim j As Integer
    Dim RstFunction As New ADODB.Recordset
    Dim CmdFunction  As New ADODB.Command
    Dim ListViewItem As ListItem
 
    Set CmdFunction.ActiveConnection = fGetConn
    CmdFunction.CommandType = adCmdText
    Set RstFunction = Cnx.OpenSchema(adSchemaProviderSpecific, , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
    LvwView.ColumnHeaders.Clear
    LvwView.ListItems.Clear
    LvwView.MultiSelect = True
    LvwView.Gridlines = True
    LvwView.FullRowSelect = True
    LvwView.LabelEdit = lvwManual
    Call ListView_Header(LvwView, RstFunction)
    Do While Not RstFunction.EOF
        Set ListViewItem = LvwView.ListItems.Add(, , RstFunction.Fields.Item(0).Value)
        For i = 1 To RstFunction.Fields.Count - 1
            If IsNull(RstFunction.Fields.Item(i).Value) = True Then
                ListViewItem.SubItems(i) = ""
            Else
                ListViewItem.SubItems(i) = RstFunction.Fields.Item(i).Value
            End If
        Next i
        RstFunction.MoveNext
    Loop
    LvwView.Refresh
    Call AutoResizeListView(LvwView, frmDB_Maintenance)
    RstFunction.Close
    Set RstFunction.ActiveConnection = Nothing
    If CBool(CmdFunction.State And adStateOpen) = True Then
        Set CmdFunction = Nothing
    End If
    If CBool(fGetConn.State And adStateOpen) = True Then
        CloseConn
    End If
 End Sub

 Sub AutoResizeListView(MyListView As Variant, Userfrm As MSForms.UserForm)
    Dim TempLabel As Object
    Dim MaxColumnWidth As Double
    Dim i As Integer
    Dim j As Integer
  
    Set TempLabel = Userfrm.Controls.Add("Forms.Label.1", "Test Label", True)
    With TempLabel
        .Font.Size = MyListView.Font.Size
        .Font.Name = MyListView.Font.Name
        .WordWrap = False
        .AutoSize = True
        .Visible = False
    End With
    TempLabel.Caption = MyListView.ColumnHeaders(1).Text
    MaxColumnWidth = TempLabel.Width
    For i = 1 To MyListView.ListItems.Count
        TempLabel.Caption = MyListView.ListItems(i).Text
        If TempLabel.Width > MaxColumnWidth Then
            MaxColumnWidth = TempLabel.Width
        End If
    Next i
    MyListView.ColumnHeaders(1).Width = MaxColumnWidth + 8
    For i = 1 To MyListView.ColumnHeaders.Count - 1
        TempLabel.Caption = MyListView.ColumnHeaders(i + 1).Text
        MaxColumnWidth = TempLabel.Width
        For j = 1 To MyListView.ListItems.Count
            TempLabel.Caption = MyListView.ListItems(j).SubItems(i)
            If TempLabel.Width > MaxColumnWidth Then
                MaxColumnWidth = TempLabel.Width
            End If
        Next j
        MyListView.ColumnHeaders(i + 1).Width = MaxColumnWidth + 8
    Next i
    Userfrm.Controls.Remove TempLabel.Name
End Sub

Answer 4

Where is the code for ListView_Header?

Answer 5

Sorry here you find the missing code:

Public Sub ListView_Header(ListView As ListView, Rst As ADODB.Recordset)
    Dim i As Integer
  
    For i = 0 To Rst.Fields.Count - 1
        ListView.ColumnHeaders.Add , , Rst.Fields.Item(i).Name, ListView.Width
    Next i
    ListView.View = lvwReport
End Sub