代码之家 › 专栏 › 技术社区 › mits

调整列表框。高度问题

height listbox vba excel

2

mits · 技术社区 · 8 年前

我有一个带有文本框的用户表单和一个带有以下计划的列表框:

用户在中输入文本 Textbox1 .
每一次 Textbox1.Text 更改后,将执行具有以下功能的搜索:
- 文本框1.Text 在工作表的特定范围内搜索。
- 文本框1.Text 可以找到多次。
- Listbox1 用搜索结果填充。

到现在为止,一直都还不错。由于有大量数据,列表可以获得许多项。在这种情况下,列表伸出屏幕,我不得不限制 Listbox1.Height . 这是上述代码:

Private Sub TextBox1_Change()
    Dim srchWord As String, firstAddress As String
    Dim srchRng As Range, cell As Range
    Dim maxRow As Integer

    ListBox1.Clear
    If TextBox1.Value = "" Then
        ListBox1.Height = 0
    Else
        With ThisWorkbook.Worksheets(1)
            maxRow = .Cells(.Rows.Count, 2).End(xlUp).Row
            Set srchRng = .Range("A2:A" & maxRow)
        End With
        srchWord = TextBox1.Value
        Set cell = srchRng.Find(srchWord, LookIn:=xlValues, lookat:=xlPart)

        With ListBox1
        If Not cell Is Nothing Then
            firstAddress = cell.Address
            Do
                If Not cell.Value Like "*(*" Then
                    .AddItem (cell.Value)
                    Select Case .ListCount
                        Case Is < 2
                            .Height = 17
                        Case Is < 21
                            .Height = 15 * .ListCount
                        Case Else
                            .Height = 272.5
                    End Select
                    Me.Height = 500
                End If
                Set cell = srchRng.FindNext(cell)
            Loop While Not cell.Address = firstAddress
        End If
        End With
    End If
End Sub

问题出在 Case Else 当滚动被启用时,我无法到达列表的最后一项。通过在网上搜索,我找到了一些潜在的解决方案:

设置 Listbox1.IntegralHeight = False 设置高度,然后再次设置 Listbox1.IntegralHeight = True
设置 Listbox1.MultiSelect = fmMultiSelectSingle 然后再次设置 Listbox1.MultiSelect = fmMultiSelectExtended .
执行上述两项操作。
Application.Wait (Now + TimeValue("0:00:01") * 0.5) 然后设置高度。

这些都不起作用。为了能够滚动到最后一项,这起到了作用:

Listbox1.IntegralHeight = False
Listbox1.Height= x
Listbox1.IntegralHeight = False
Listbox1.Height= x

但这也设置了Listbox1。单个项目的高度。(右侧有箭头)

有人知道我究竟要如何控制Listbox1吗。没有这些不必要的行为?此外,如果有人能提出另一种结构,可以遵循最初提到的计划,我愿意放弃列表框。

2 回复 | 直到 6 年前

1

3

T.M. 8 年前

这似乎是一种未被完全探究的行为。

根据我的经验,只是重新定义了一些列表框参数。
尝试推荐的 .IntegralHeight 虚假和真实。
在某些情况下,另一种可能的测量方法会有所帮助:尝试为列表框选择接近以下乘法的高度:

列表框高度=(字体大小+2分)*(每页最大项目数)

在后面插入以下代码 With ListBox1 :

  With ListBox1
    .Top = 18                   ' << redefine your starting Point
    .Font.Size = 10             ' << redefine your font size
    .IntegralHeight = False     ' << try the cited recommendation :-)

插入以下代码之前 End With :

    .Height = .Height + .Font.Size + 2
    .IntegralHeight = True
    End With

希望这有帮助。

链接

请参阅另一种更快的过滤列表框的方法 How to speed up filling of listbox values on userform excel

2

1

mits 8 年前

感谢您的快速回复和宝贵时间。你的回答给了我想要的,这就是为什么我要这样做。我张贴这只是为了将来参考。

我最终实施了这个计划。

首先,我插入:

这

With ListBox1
    .Top = 18
    .Font.Size = 10
    .IntegralHeight = False

还有这个

    .Height = .Height + .Font.Size + 2
    .IntegralHeight = True
End With

我链接了 .Height 具有 .Font.Size 正如你建议的那样。只要不需要为高度指定绝对值,就不需要 Select Case 我的代码中的语句。

此外,我意识到没有必要在每次添加一个项目时更改高度,而只需要在过程结束时更改,因此我将其从循环中删除。
最后,我添加了一段代码,当Textbox1为空时,该代码将使列表不可见。代码如下:

最终用户表单代码:

Option Compare Text
Option Explicit

Private bsdel As Boolean 'indicates if backspace or delete keys have been hit.


Private Sub ListBox1_Click()
    Dim cell As Range
    Dim maxRow As Integer

    With ThisWorkbook.Worksheets(1)
        maxRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        Set cell = .Range("A1:A" & maxRow).Find(UserForm11.ListBox1.Text, LookIn:=xlValues, lookat:=xlWhole)
        If Not cell Is Nothing Then 
            cell.Select
            'do other stuff also.
        End If
    End With
End Sub


Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    bsdel = False
    If KeyCode = 8 Or KeyCode = 46 Then _
        bsdel = True
End Sub

Private Sub TextBox1_Change()
    Dim srchWord As String, firstAddress As String
    Dim srchRng As Range, cell As Range
    Dim maxRow As Integer

    ListBox1.Clear
    ListBox1.Visible = True
    If bsdel And TextBox1.Value = "" Then
        ListBox1.Visible = False
        Me.Height = 130
    Else
        With ThisWorkbook.Worksheets(1)
            maxRow = .Cells(.Rows.Count, 2).End(xlUp).Row
            Set srchRng = .Range("A1:A" & maxRow)
        End With
        srchWord = TextBox1.Value
        Set cell = srchRng.Find(srchWord, LookIn:=xlValues, lookat:=xlPart)

        With ListBox1
            '.Top = 84          'test made: deleting this made no difference.
            '.Font.Size = 10    'test made: deleting this made no difference.
            .IntegralHeight = False

            If Not cell Is Nothing Then
                firstAddress = cell.Address
                Do
                    If Not cell.Value Like "*(*" Then 'this range includes notes within parenthesis and I didn't need them.
                        .AddItem (cell.Value)
                    End If
                    Set cell = srchRng.FindNext(cell)
                Loop While Not cell.Address = firstAddress
                If .ListCount < 21 Then 'the size is adjusted.
                    .Height = (.Font.Size + 2) * .ListCount
                Else 'the size stays fixed at maximum.
                    .Height = (.Font.Size + 2) * 20
                End If
            End If
            Me.Height = .Height + 130

            .Height = .Height + .Font.Size + 2 
            .IntegralHeight = True
        End With
    End If
    bsdel = False
End Sub


Private Sub UserForm_Activate()
    TextBox1.SetFocus
End Sub


Private Sub UserForm_Initialize()
    ListBox1.Visible = False
End Sub