Option Explicit 
Private Const LB_SETHORIZONTALEXTENT = &H194 
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 

Private Sub Command1_Click() 
Dim max As Long, f As Font, i As Integer 

Me.ScaleMode = vbPixels 
Set f = Me.Font 
Set Me.Font = List1.Font 

With List1 
For i = 0 To .ListCount 
If Me.TextWidth(.List(i)) > max Then 
max = Me.TextWidth(.List(i)) 
End If 
Next 
End With 
max = max + 10 

Set Me.Font = f 

SendMessage List1.hwnd, LB_SETHORIZONTALEXTENT, max, ByVal 0& 
End Sub 

Private Sub Form_Load() 
List1.AddItem "VB编程乐园" 
List1.AddItem "http://www.vbeden.com" 
List1.AddItem "这是一个特别特别长的选项，长到超过ListBox的范围" 
End Sub