datasheet font set in module

[ano]

sorry corrected na

for each control
....
next control

is easy read and coding but very slow in production

[ano]

Option Compare DatabaseOption Explicit


Public Sub clm(frm1 As Form, Optional fst As Boolean)
Dim ctl As Control
Dim frms As Variant
Dim frm As Variant
Dim i As Integer
i = 0
If fst Then
 ScreenRes
 y(0) = "-P888,888.88"
 x(12) = frm1.Toggle22.FontSize
 x(13) = frm1.Toggle22.FontWeight
 y(1) = frm1.Toggle22.FontName
 Else
 frm1.Toggle22.FontSize = x(12)
 frm1.Toggle22.FontWeight = x(13)
 frm1.Toggle22.FontName = y(1)
 frm1.Toggle22.Height = x(12) * 24
 frm1.Toggle22.Width = w
End If
x(0) = 0        'u y  top seems useless
x(1) = 0        'u x  left
Do
    GetTextLength frm1.Toggle22, y(0)
    If w < 900 Then
        w = 900
        End If
    x(2) = 11 * w   'u w
    If x(2) > 31680 Then
        x(12) = x(12) - 1
        frm1.Toggle22.FontSize = x(12)
        Else
        Exit Do
        End If
    Loop Until x(2) < 31681
frm1.fnt2.Value = x(12) & y(1) & w
frm1.fnt2.BackColor = vbGreen
frm1.fnt2.ForeColor = vbBlue
x(3) = 800      'u h
x(4) = 400     's y  top seems useless
x(5) = 0     's x  left
x(6) = w + w / 2 's w
x(7) = 800     's h
x(8) = x(6)     'b y top seems useless
x(9) = x(5)     'b x left
x(10) = x(2) - x(6)  'b w
x(11) = x(7)    'b h
DoCmd.MoveSize 0, 0
DoCmd.Maximize
frms = Array("used", "saving", "bal_crosstab")
For Each frm In frms
    For Each ctl In Forms!form1!(frm).Form.Controls
        With ctl
            If .ControlType = acTextBox Then
                 .CanGrow = True
                .CanShrink = True
                 Select Case .Name
                    Case Is = "Tot"
                        .ColumnWidth = w + w / 6
                    Case Is = "dt"
                        .ColumnWidth = w - w / 12
                    Case Else
                        .ColumnWidth = w
                    End Select
                End If
            End With
        Next ctl
    Forms!form1!(frm).Form.DatasheetFontName = y(1)
    Forms!form1!(frm).Form.DatasheetFontHeight = x(12)
    Forms!form1!(frm).Form.DatasheetFontWeight = 700
    Forms!form1!(frm).Form.RowHeight = x(12) * 24
    Forms!form1!(frm).Form.DatasheetBackColor = vbYellow
    Forms!form1!(frm).Form.DatasheetForeColor = vbRed
    If frm = "used" Then
        x(3) = Forms!form1!(frm).Form.RowHeight * 2.5 + 250
        Forms!form1!saving.Form.Recordset.MoveLast
        Forms!form1!saving.Form.Recordset.MoveFirst
        x(7) = (Forms!form1!saving.Form.Recordset.RecordCount + 3) * Forms!form1!(frm).Form.RowHeight
        x(11) = x(7)
        End If
    Forms!form1!(frm).Top = x(i + 0)
    Forms!form1!(frm).Left = x(i + 1)
    Forms!form1!(frm).Width = x(i + 2)
    Forms!form1!(frm).Height = x(i + 3)
    i = i + 4
    Next frm
Forms!form1!used!fil.ColumnWidth = Forms!form1!(frm).Width - w + 90
hnp frm1
End Sub


Function hnp(ByRef happy As Form)
  Dim strCurrentObjectName As String
  strCurrentObjectName = Application.CurrentObjectName
  DoCmd.NavigateTo ("acNavigationCategoryObjectType")
  If strCurrentObjectName <> Application.CurrentObjectName Then
    DoCmd.RunCommand acCmdWindowHide
    End If
End Function


Function df() As Boolean
    Dim f As FormFontInfo
    With f
      .Color = 0
      .Height = 12
      .Weight = 700
      .Italic = False
      .UnderLine = False
      .Name = "Arial"
    End With
    Call DialogFont(f)
    With f
        y(1) = .Name
        x(12) = .Height
        x(13) = .Weight
     End With
    df = True
End Function


Sub ScreenRes()
    x(15) = GetSystemMetrics32(0) ' width in points
    x(16) = GetSystemMetrics32(1) ' height in points
End Sub


Public Function GetTextLength(pCtrl As Control, ByVal str As String, Optional ByVal Height As Boolean = False)
      Dim lx As Long, ly As Long
      WizHook.Key = 51488399
      WizHook.TwipsFromFont pCtrl.FontName, pCtrl.FontSize, pCtrl.FontWeight, _
            pCtrl.FontItalic, pCtrl.FontUnderline, 0, str, 0, lx, ly
      If Not Height Then
            w = lx
      Else
            GetTextLength = ly
      End If
End Function