【Access小品】列表框宽度自适应

卡西达

　　昨天根据版友石三少同志的问题编写了一个导入导出的实例，在这个实例中用到了列表框来显示不同表的数据，这样的处理有个好处可以不必考虑子窗体增减控件的问题。但是昨天的实例留下来一个小问题，就是不同的数据表列宽都是一致的，数据要么显示不全，要么留白太多，实在不美观。根据这样一个遗留问题，今日写就本实例，解决列表框列宽自适应记录宽度问题。

1. 
   
2. Function GetcomWidths(ctl As Control, ftSize As Long)
   
3. '功能：列表框字段框度自适应
   
4. '参数：ctl--列表框控件,ftSize--字号
   
5. '示例：GetcomWidths me.记录,10
   
6. Dim rs As New ADODB.Recordset
   
7. Dim i As Long, j As Long
   
8. Dim comWidths As String
   
9. Dim w As Single
   
10. rs.Open ctl.RowSource, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    
11. ctl.FontSize = ftSize
    
12. For i = 0 To rs.Fields.Count - 1
    
13.         rs.MoveFirst
    
14.         w = 0
    
15.         For j = 1 To rs.RecordCount
    
16.               If Len(Nz(rs(i).Value, "")) > w Then w = Len(Nz(rs(i).Value, ""))
    
17.               rs.MoveNext
    
18.         Next
    
19.         If w > 20 Then w = 20
    
20.         w = 0.0353 * (w + 1) * ctl.FontSize
    
21.         comWidths = comWidths & w & " cm;"
    
22. Next
    
23. ctl.ColumnWidths = comWidths
    
24. rs.Close
    
25. End Function

复制代码

附件下载：列表框宽度自适应.rar