標題:
[發問]
ListBox.ColumnWidths有辦法設定為自動欄寬嗎?
[打印本頁]
作者:
PKKO
時間:
2014-11-12 08:04
標題:
ListBox.ColumnWidths有辦法設定為自動欄寬嗎?
Sub checkWashCar()
Dim arr(), rng, i%, j%, m%
aaa = WorksheetFunction.CountA(Rows("1:1"))
Me.ListBox1.ColumnCount = aaa
Me.ListBox1.ColumnWidths = "60,100,60"
rng = [a1].CurrentRegion
For i = 1 To UBound(rng)
If i = 1 Or rng(i, searchW) Like serchItem Then
m = m + 1
ReDim Preserve arr(1 To aaa, 1 To m)
For j = 1 To aaa
arr(j, m) = rng(i, j)
Next
End If
Next
Me.ListBox1.List() = Application.Transpose(arr)
End Sub
複製代碼
實際上我的字數有可能變多或是變少,有可能依據字數自動欄寬嗎?
而不要像我原本的方式手動欄寬?
作者:
stillfish00
時間:
2014-11-12 17:21
回復
1#
PKKO
ListBox是Userform上的還是工作表上的?
作者:
stillfish00
時間:
2014-11-12 20:30
回復
1#
PKKO
假設是指Userform上ListBox,
可利用暫時的TextBox來找出各欄最大寬度再設定
Sub checkWashCar()
Dim arr(), rng, i%, j%, m%
aaa = WorksheetFunction.CountA(Rows("1:1"))
Me.ListBox1.ColumnCount = aaa
'Me.ListBox1.ColumnWidths = "60,100,60"
rng = [a1].CurrentRegion
For i = 1 To UBound(rng)
If i = 1 Or rng(i, searchW) Like serchItem Then
m = m + 1
ReDim Preserve arr(1 To aaa, 1 To m)
For j = 1 To aaa
arr(j, m) = rng(i, j)
Next
End If
Next
Me.ListBox1.List = Application.Transpose(arr)
'新增以下code
Dim sWidth As String, dTotal As Double
Dim oTemp As Object
Set oTemp = Me.Controls.Add("Forms.TextBox.1")
With oTemp
.AutoSize = True
.MultiLine = True
.WordWrap = False
.SelectionMargin = False
.Font.Name = Me.ListBox1.Font.Name
.Font.Size = Me.ListBox1.Font.Size
End With
For j = 0 To Me.ListBox1.ColumnCount - 1
oTemp.Text = ""
For i = 0 To Me.ListBox1.ListCount - 1
oTemp.Text = oTemp.Text & Me.ListBox1.List(i, j) & vbCr
Next
dTotal = dTotal + oTemp.Width
sWidth = sWidth & oTemp.Width & ";"
Next
Me.Controls.Remove oTemp.Name
Me.ListBox1.Width = dTotal + Me.ListBox1.ColumnCount + 5
Me.ListBox1.ColumnWidths = sWidth
End Sub
複製代碼
作者:
PKKO
時間:
2014-11-13 03:22
回復
3#
stillfish00
感謝大大,完全了解,原來還有這種方法,借鏡再把鏡子刪除,感恩哦!!
另外還想請問一下
一、listbox有辦法有分隔線嗎?(A欄與B欄之間有分隔線,或是第一列與第二列中間有分隔線?)
二、我在看過別人的listbox可以輸出至sheet內,變成sheet1的內容,要如何辦到呢~?
作者:
PKKO
時間:
2014-11-13 07:52
回復
3#
stillfish00
為何第一次搜尋,欄寬都會正常顯示,但第二次搜尋,欄寬就跑掉了(總欄寬),無法出現卷軸往右邊移動
但是只要退出USERFORM再重新搜尋一次,都會是正確的,搜尋完不關閉USERFORM,在搜尋一次都會是錯的~?
作者:
stillfish00
時間:
2014-11-13 13:33
回復
4#
PKKO
1. ListBox 控制項無分隔線設定,有興趣可找 ListView 控制項試試
2. 輸出到工作表,不懂你問題在哪,下面code就能簡單做到了
Private Sub CommandButton2_Click()
Dim ar
ar = Me.ListBox1.List
With Sheets(3).[A1].Resize(UBound(ar) + 1, UBound(ar, 2) + 1)
.Value = ar
.EntireColumn.AutoFit
End With
End Sub
複製代碼
作者:
stillfish00
時間:
2014-11-13 13:37
回復
5#
PKKO
Me.ListBox1.Width = dTotal + Me.ListBox1.ColumnCount + 5
這行是調整總寬度,要固定總寬度就不要加
作者:
PKKO
時間:
2014-11-14 23:05
回復
7#
stillfish00
感謝大大,我再試試看!!
作者:
PKKO
時間:
2014-11-16 08:27
回復
6#
stillfish00
This is very nice code,thanks.
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)