listbox 标题常驻

opiona

Listbix用数组直接赋值
随着滚动条下拉 标题不能固定在原位 不太方便
变通了一下:
先将数据保存到一个临时表
再将临时表的数据显示到 Listbox
标题就变的和ListView一样 可以一直在上面显示

代码中同时实现:
鼠标滚轮的上下滚动条,左右滚动条(同时按下Shift)
通过一个自定义函数实现自动设置 Listbox列宽 为适应宽度
         
listbox标题行常驻_示例.rar (124.37 KB, 下载次数: 144)

2022-11-12 09:37 上传

点击文件名下载附件

1. Sub ListBox标题常驻设置(ARX, ListA, Optional ByVal ShName As String = "ListBox标题常驻")
   
2.     '''    With ListBox1
   
3.     '''        .Clear   ' 清除列表框。
   
4.     '''        .ColumnCount = UBound(DRX, 2) '设置7列
   
5.     '''        .ColumnWidths = GetListBoxWidth(DRX)   '设置每列宽度
   
6.     '''        .ListStyle = 0   '带有复选框
   
7.     '''        .MultiSelect = 0  '表示对象是否允许多项选择
   
8.     '''        rem List = DRX           '内容来自一个数组
   
9.     '''        Rem 其他都正常设置, 调用: 标题常驻
   
10.     '''        Call ListBox标题常驻设置(DRX, ListBox1)
    
11.     '''    End With
    
12.    
    
13.     Rem 临时表需要临时设置  满足文本身份证类的显示
    
14.     Rem ARX   二维数组要求有标题
    
15.     Rem ListA  Listbox名称
    
16.     Rem  ShName   临时工作表名
    
17.    
    
18.     Set SHX = Worksheets(ShName)
    
19.     SHX.Cells.ClearContents
    
20.     LB = LBound(ARX)
    
21.     SHX.Range("A1").Resize(UBound(ARX, 1) + (1 - LB), UBound(ARX, 2) + (1 - LB)) = ARX
    
22.     MAXCOL = SHX.Range("IT1").End(xlToLeft).Column
    
23.     MAXROW = SHX.Range("A" & SHX.Rows.Count).End(3).Row
    
24.     With ListA
    
25.         .ColumnHeads = True
    
26.         .TextAlign = fmTextAlignCenter
    
27.         .RowSource = SHX.Range("A2:" & SHX.Cells(MAXROW, MAXCOL).Address).Address(External:=True)
    
28.     End With
    
29. End Sub
    

复制代码

1. Function GetListBoxWidth(ByVal ARX, Optional ByVal LB As Long = -1) As String
   
2.     Dim I, INTX, x, y, Z, ICOL, MAXROW, MinWidth, MaxWidth, MinNums As Long
   
3.     Dim StrX As String
   
4.     Rem 按照数组设置ListBox各列的宽度
   
5.     Rem  ARX    数组
   
6.     Rem  LB       起始值 默认是-1  自动计算
   
7.     Rem  使用方法: .ColumnWidths = GetListBoxWidth(ARX)   '设置每列宽度
   
8.     Rem  宽度值 最小和最大宽度
   
9.     MinWidth = 12
   
10.     MaxWidth = 60
    
11.     MinNums = 6  '//每个字符宽度
    
12.     Rem 为了速度,只判断100行
    
13.     MAXROW = 100
    
14.     If UBound(ARX, 1) < 100 Then MAXROW = UBound(ARX, 1)
    
15.     StrX = ""
    
16.     If LB = -1 Then LB = LBound(ARX, 1) '//开始行    可以提前指定  =0 or =1
    
17.     For y = LB To UBound(ARX, 2)
    
18.         INTX = 0
    
19.         For x = LB To MAXROW
    
20.             Rem 获得字符串实际长度，中文2，英文1
    
21.             Z = 0
    
22.             If LenB(ARX(x, y)) > 0 Then
    
23.                 Z = LenB(ARX(x, y))
    
24.             End If
    
25.             If Z > INTX Then INTX = Z
    
26.         Next
    
27.         If INTX < MinWidth Then INTX = MinWidth    '//最小宽度
    
28.         If INTX > MaxWidth Then INTX = MaxWidth '//最大宽度
    
29.         Rem 获得此列的宽度
    
30.         If StrX <> "" Then StrX = StrX & ","
    
31.         StrX = StrX & INTX * MinNums
    
32.     Next
    
33.     GetListBoxWidth = StrX
    
34. End Function
    

复制代码

wowo000

尊敬的opiona老师：您好！提个菜白问题，即可否用“CreateObject("excel.sheet")”虚拟表代替“Listbox标题常驻”工作表吗？？？

opiona

wowo000 发表于 2022-11-12 21:23
尊敬的opiona老师：您好！提个菜白问题，即可否用“CreateObject("excel.sheet")”虚拟表代替“Listbox标题 ...

这个一点都不白
我还是第一次知道
实话说 不知道怎么用  你可以试试