アクセスのレポートで文字縮小(エクセルの縮小して全体を表示するみたいに)
教えてください。
アクセスレポートのテキストボックスをそのサイズを変えずに文字を縮小する(エクセルの書式設定の縮小して全体を表示にすると同じように)にはどうしたらよいのでしょうか。
ネットで検索したら あったのですがうまくいきませんでした。
以下引用
****************************
以前作成したことのある枠内に収まるようフォントサイズを
自動調整する関数です。
Public Sub AutoFontSize(Ctr As Control, IniFontSize As Integer)
Const MinFontSize = 4 '最小のフォントサイズ
Const d = 40 'うまく収まらずに改行されてしまう場合はここの数値を増やす
Dim rpt As Report, Str As String, W As Long
Dim arStr, i As Integer, H As Long
Set rpt = CodeContextObject
With rpt
If Ctr.ControlType = acTextBox Then
Str = Ctr.Text
ElseIf Ctr.ControlType = acLabel Then
Str = Ctr.Caption
Else
Exit Sub
End If
If Str = "" Then Exit Sub
.FontName = Ctr.FontName
If Ctr.Vertical Then
W = Ctr.Height - d
H = Ctr.Width - d
If InStr(1, .FontName, "@") = 0 Then
.FontName = "@" & .FontName
Else
.FontName = Mid(.FontName, 2)
End If
Else
W = Ctr.Width - d
H = Ctr.Height - d
End If
arStr = Split(Str, vbCrLf)
Str = arStr(0)
For i = 1 To UBound(arStr)
If .TextWidth(arStr(i)) > .TextWidth(Str) Then Str = arStr(i)
Next
.ScaleMode = 1
If Ctr.FontBold = 1 Then .FontBold = True
.FontSize = IniFontSize
Do Until rpt.FontSize = MinFontSize
If W > .TextWidth(Str) Then
Exit Do
End If
.FontSize = .FontSize - 1
Loop
Do Until rpt.FontSize = MinFontSize
If H > .TextHeight("A") * (UBound(arStr) + 1) + Ctr.LineSpacing * UBound(arStr) Then
Exit Do
End If
.FontSize = .FontSize - 1
Loop
Ctr.FontSize = .FontSize
End With
End Sub
使い方は、
前記の関数を標準モジュールに作成します。
レポートのセクションのフォーマット時イベントで、
AutoFontSize Me.テキストボックス名, 12
というように記述します。
第2引数は、フォントサイズの初期値です。
枠内に収まりきらないときは、収まるサイズまで縮小します。
ただし、Const MinFontSize = 4 で指定したサイズまでです。
*******************
というのをそのままコピーして試してみたのですが、
「マクロがみつかりません」というエラーがでてしまいました。
何か他に簡単な方法もしくは上記の表現を補足わかりやすくしてくださるようお願いします。
お礼
ありがとうございました。 おかげで出来ました。