设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

12下一页
返回列表 发新帖
查看: 5129|回复: 11
打印 上一主题 下一主题

[模块/函数] 【Access小品】列表框宽度自适应

[复制链接]
跳转到指定楼层
1#
发表于 2010-7-22 11:11:15 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
  昨天根据版友石三少同志的问题编写了一个导入导出的实例,在这个实例中用到了列表框来显示不同表的数据,这样的处理有个好处可以不必考虑子窗体增减控件的问题。但是昨天的实例留下来一个小问题,就是不同的数据表列宽都是一致的,数据要么显示不全,要么留白太多,实在不美观。根据这样一个遗留问题,今日写就本实例,解决列表框列宽自适应记录宽度问题。
Function GetcomWidths(ctl As Control, ftSize As Long)
'功能:列表框字段框度自适应
'参数:ctl--列表框控件,ftSize--字号
'示例:GetcomWidths me.记录,10
Dim rs As New ADODB.Recordset
Dim i As Long, j As Long
Dim comWidths As String
Dim w As Single
rs.Open ctl.RowSource, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
ctl.FontSize = ftSize
For i = 0 To rs.Fields.Count - 1
    rs.MoveFirst
    w = 0
    For j = 1 To rs.RecordCount
        If Len(Nz(rs(i).Value, "")) > w Then w = Len(Nz(rs(i).Value, ""))
        rs.MoveNext
    Next
    If w > 20 Then w = 20
    w = 0.0353 * (w + 1) * ctl.FontSize
    comWidths = comWidths & w & " cm;"
Next
ctl.ColumnWidths = comWidths
rs.Close
End Function




本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x

评分

参与人数 1经验 +8 收起 理由
5988143 + 8 非常不錯的技巧~

查看全部评分

本帖被以下淘专辑推荐:

  • · 控件|主题: 8, 订阅: 0
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖1 订阅订阅
2#
发表于 2010-7-22 11:53:27 | 只看该作者
非常不錯的技巧~
3#
发表于 2010-7-22 15:38:24 | 只看该作者
学习
4#
发表于 2010-8-22 11:03:41 | 只看该作者
非常不錯的技巧~
5#
发表于 2010-12-10 15:07:07 | 只看该作者
很虔诚地向前辈大师学习,谢谢!
6#
发表于 2011-1-16 22:07:44 | 只看该作者
路过,学习

点击这里给我发消息

7#
发表于 2011-1-16 22:09:38 | 只看该作者
这个实例太好了,多谢楼主!

点击这里给我发消息

8#
发表于 2011-1-16 22:43:16 | 只看该作者
能有 LISTVIEW 宽度自适应 就更好了,呵呵
9#
发表于 2011-1-16 23:00:16 | 只看该作者
学习了
10#
发表于 2013-1-17 22:40:08 | 只看该作者
有两个问题1是不能超过28列否则报错不能自适应,2是输入数字的时候一个数字多出一个空白格,就这样11111     ,无法解决。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-5-10 11:27 , Processed in 0.097358 second(s), 38 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表