Public Function FixColumnWidthsOfQuery _
(stName As String)
Dim db As Database
Dim qdf As QueryDef
Dim fld As DAO.Field
Dim frm As Form
Dim ictl As Integer
Dim ctl As Control
Set db = CurrentDb
Set qdf = db.QueryDefs(stName)
DoCmd.OpenQuery stName, acViewNormal
Set frm = Screen.ActiveDatasheet
For ictl = 0 To frm.Controls.Count - 1
Set ctl = frm.Controls(ictl)
ctl.ColumnWidth = -2
Call SetDAOFieldProperty(qdf.Fields(ictl), _
"ColumnWidth", ctl.ColumnWidth, dbInteger)
Next ictl
DoCmd.Save acQuery, stName
End Function
Public Function FixColumnWidthsOfTable _
(stName As String)
Dim db As Database
Dim tdf As TableDef
Dim fld As DAO.Field
Dim frm As Form
Dim ictl As Integer
Dim ctl As Control
Set db = CurrentDb
Set tdf = db.TableDefs(stName)
DoCmd.OpenTable stName, acViewNormal
Set frm = Screen.ActiveDatasheet
For ictl = 0 To frm.Controls.Count - 1
Set ctl = frm.Controls(ictl)
ctl.ColumnWidth = -2
Call SetDAOFieldProperty(tdf.Fields(ictl), _
"ColumnWidth", ctl.ColumnWidth, dbInteger)
Next ictl
DoCmd.Save acTable, stName
End Function
Private Sub SetDAOFieldProperty _
(fld As DAO.Field, _
stName As String, vValue As Variant, _
lType As Long)
Dim prp As DAO.Property
For Each prp In fld.Properties
If StrComp(prp.Name, stName, _
vbBinaryCompare) = 0 Then
prp.Value = vValue
Exit For
End If
Set prp = Nothing
Next prp
If prp Is Nothing Then
Set prp = fld.CreateProperty(stName, _
lType, vValue)
fld.Properties.Append prp
End If
End Sub