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
