ListView Column Width

[Rex2024]

I would like to either manually set the width for each column in my listview. In addition, I'd like to be able to word wrap certain columns. How can I do this?

Option Explicit

Private Sub Add_Click()

End Sub

Private Sub UserForm_Activate()

With Me.LV1
    .View = lvwReport
    .Gridlines = True
    .HideColumnHeaders = False
End With

Call LoadListView

End Sub

Private Sub LoadListView()

Dim wksSource As Worksheet
Dim rngData As Range
Dim RngCell As Range
Dim LstItem As ListItem
Dim RowCount As Long
Dim ColCount As Long
Dim i As Long
Dim j As Long

Set wksSource = Worksheets("FormDataTesting")
Set rngData = wksSource.Range("A1").CurrentRegion

For Each RngCell In rngData.Rows(1).Cells
    Me.LV1.ColumnHeaders.Add Text:=RngCell.Value, Width:=90
Next RngCell

RowCount = rngData.Rows.Count

ColCount = rngData.Columns.Count

For i = 2 To RowCount
    Set LstItem = Me.LV1.ListItems.Add(Text:=rngData(i, 1).Value)
    For j = 2 To ColCount
        LstItem.ListSubItems.Add Text:=rngData(i, j).Value
    Next j
Next i

End Sub

 

[Rex2024]

I have resolved my issue.

 

[astrodon]

I have resolved my issue.

So, tell us Mr. Wizard, what was the resolution to the issue? I have the same problem and wish to solve it as well.

TIA
doco

 

[Rex2024]

Sorry! Should have posted that. I never did wrap text, but this is how I got columns to the sizes I wanted.

    With EventLog.ListView1
    
'Build column headers
    .ListItems.Clear
    .ColumnHeaders.Clear
    .FullRowSelect = True
    .ColumnHeaders.Add , , "Event ID", 0
    .ColumnHeaders.Add , , "EmpNum", 50
    .ColumnHeaders.Add , , "First Name", 80
    .ColumnHeaders.Add , , "Last Name", 80
    .ColumnHeaders.Add , , "Subject", 60
    .ColumnHeaders.Add , , "Subject Detail", 60
    .ColumnHeaders.Add , , "Details", 250

'To speed things up my listview uses an array

    Set LVRange = ws.Range("A1").CurrentRegion
    LVArray = LVRange
    
    X = 1
    
    On Error Resume Next
    
    For P = UBound(LVArray) To 0 Step -1
        If X > 500 Then 'I only wanted 500 items. This counts the latest and then goes in reverse
            GoTo Count500
        Else
        End If
        
    Set el = .ListItems.Add(, , LVArray(P, 1)) 'Event ID
    el.ListSubItems.Add , , LVArray(P, 2) 'EmpNum
    el.ListSubItems.Add , , LVArray(P, 4) 'Last Name
    el.ListSubItems.Add , , LVArray(P, 3) 'First Name
    el.ListSubItems.Add , , LVArray(P, 12) 'Subject
    el.ListSubItems.Add , , LVArray(P, 13) 'Subject Detail
    el.ListSubItems.Add , , LVArray(P, 5) 'Details

    X = X + 1
    
    Next P

End With

 

[astrodon]

Yes, this is good when loading one at a time. But loading a ListView from an Excel Table using a For Loop doesn't allow for that. It would be good to loop through each column after the fact and set widths based on widest ListItem content.

I see several instances of this in VB|.Net|C# but can not find an example for VBA. Surely there is one.

Thanks for the comeback
doco

 

[Rex2024]

Yes, this is good when loading one at a time. But loading a ListView from an Excel Table using a For Loop doesn't allow for that. It would be good to loop through each column after the fact and set widths based on widest ListItem content.

I see several instances of this in VB|.Net|C# but can not find an example for VBA. Surely there is one.

Thanks for the comeback
doco

Yeah, I never figured it out and ended up just going this route. Sorry I wasn't more help for your need!

 

[astrodon]

Yeah, I never figured it out and ended up just going this route. Sorry I wasn't more help for your need!

You did just fine

 

[novit19089]

I have resolved my issue.

Hello! Can I see how you solve the problem? I am also experiencing the same situation

 

[Jaafar Tribak]

I don't have the ListView control installed since I am on 64bit excel so I can't carry out a test but, I suspect that since the LisView has a window handle ,sending the SET_COLUMN_WIDTH message along with AUTOSIZE_USEHEADER lParam should work

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
#Else
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#End If

Public Sub AutosizeColumns(ByVal TargetListView As ListView)
    Const SET_COLUMN_WIDTH    As Long = 4126&
    Const AUTOSIZE_USEHEADER  As Long = -2&
    Dim lColumn As Long
    For lColumn = 0& To TargetListView.ColumnHeaders.Count - 1&
        Call SendMessage(TargetListView.hwnd, SET_COLUMN_WIDTH, lColumn, ByVal AUTOSIZE_USEHEADER)
    Next lColumn
End Sub

The just call it like this:

Call AutosizeColumns(ListView1)