Access:レポート項目で縮小して全体を表示する

Accessのレポート項目で、Excelの「縮小して全体を表示する」を行う関数。

↓の関数はとりあえず１行のテキストしか想定していない。いろんなパターンに対応するなら、クラスを作ってレポートオープン時に項目を指定してフォントサイズやマージンの初期値を保持し、印刷時に実行するのが良いと思う。

Sub ShrinkToFit(ctl As Control, ByVal FontSize As Integer)
Dim BaseHeight As Integer
    With CodeContextObject
        .FontName = ctl.FontName
        .FontSize = FontSize
        .FontBold = ctl.FontBold
        .FontItalic = ctl.FontItalic
        .FontUnderline = ctl.FontUnderline
        BaseHeight = .TextHeight(ctl.Value)
        '文字が切れた場合があったので-50で調整
        Do Until .TextWidth(ctl.Value) < (ctl.Width - ctl.LeftMargin - ctl.RightMargin - 50) Or .FontSize = 1
            .FontSize = .FontSize - 1
        Loop
        ctl.FontSize = .FontSize
        ctl.TopMargin = (BaseHeight - .TextHeight(ctl.Value)) \ 2
    End With
End Sub