Board logo

標題: [發問] ListBox.ColumnWidths有辦法設定為自動欄寬嗎? [打印本頁]
作者: PKKO    時間: 2014-11-12 08:04     標題: ListBox.ColumnWidths有辦法設定為自動欄寬嗎?

  1. Sub checkWashCar()
  2.    
  3.     Dim arr(), rng, i%, j%, m%
  4.     aaa = WorksheetFunction.CountA(Rows("1:1"))
  5.     Me.ListBox1.ColumnCount = aaa
  6.     Me.ListBox1.ColumnWidths = "60,100,60"
  7.    
  8.     rng = [a1].CurrentRegion
  9.     For i = 1 To UBound(rng)
  10.         If i = 1 Or rng(i, searchW) Like serchItem Then
  11.             m = m + 1
  12.             ReDim Preserve arr(1 To aaa, 1 To m)
  13.             For j = 1 To aaa
  14.                 arr(j, m) = rng(i, j)
  15.             Next
  16.         End If
  17.     Next
  18.     Me.ListBox1.List() = Application.Transpose(arr)

  20. End Sub
複製代碼
實際上我的字數有可能變多或是變少,有可能依據字數自動欄寬嗎?
而不要像我原本的方式手動欄寬?
作者: stillfish00    時間: 2014-11-12 17:21

回復 1# PKKO
ListBox是Userform上的還是工作表上的?
作者: stillfish00    時間: 2014-11-12 20:30

回復 1# PKKO
假設是指Userform上ListBox，
可利用暫時的TextBox來找出各欄最大寬度再設定
  1. Sub checkWashCar()
  2.   Dim arr(), rng, i%, j%, m%
  3.   aaa = WorksheetFunction.CountA(Rows("1:1"))
  4.   Me.ListBox1.ColumnCount = aaa
  5.   'Me.ListBox1.ColumnWidths = "60,100,60"
  6.   
  7.   rng = [a1].CurrentRegion
  8.   For i = 1 To UBound(rng)
  9.     If i = 1 Or rng(i, searchW) Like serchItem Then
  10.       m = m + 1
  11.       ReDim Preserve arr(1 To aaa, 1 To m)
  12.       For j = 1 To aaa
  13.         arr(j, m) = rng(i, j)
  14.       Next
  15.     End If
  16.   Next
  17.   Me.ListBox1.List = Application.Transpose(arr)

  19.   '新增以下code
  20.   Dim sWidth As String, dTotal As Double
  21.   Dim oTemp As Object
  22.   
  23.   Set oTemp = Me.Controls.Add("Forms.TextBox.1")
  24.   With oTemp
  25.     .AutoSize = True
  26.     .MultiLine = True
  27.     .WordWrap = False
  28.     .SelectionMargin = False
  29.     .Font.Name = Me.ListBox1.Font.Name
  30.     .Font.Size = Me.ListBox1.Font.Size
  31.   End With
  32.   
  33.   For j = 0 To Me.ListBox1.ColumnCount - 1
  34.     oTemp.Text = ""
  35.     For i = 0 To Me.ListBox1.ListCount - 1
  36.       oTemp.Text = oTemp.Text & Me.ListBox1.List(i, j) & vbCr
  37.     Next
  38.     dTotal = dTotal + oTemp.Width
  39.     sWidth = sWidth & oTemp.Width & ";"
  40.   Next
  41.   Me.Controls.Remove oTemp.Name
  42.   Me.ListBox1.Width = dTotal + Me.ListBox1.ColumnCount + 5
  43.   Me.ListBox1.ColumnWidths = sWidth
  44. 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就能簡單做到了
  1. Private Sub CommandButton2_Click()
  2.   Dim ar
  3.   
  4.   ar = Me.ListBox1.List
  5.   With Sheets(3).[A1].Resize(UBound(ar) + 1, UBound(ar, 2) + 1)
  6.     .Value = ar
  7.     .EntireColumn.AutoFit
  8.   End With
  9. 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/)