MS Access Tips/Sample and VBA and Blog customize etc...

テキストボックス内の文字を自動で縮小して全体を表示

レポートでテキストボックスに文字を表示する場合は、文字列が長すぎると、はみ出た部分は切れて表示されません。その場合、自動的にフォントサイズを縮小して全体が表示できるようなればと思ったことはありませんか。

Excel では書式設定の「縮小して全体を表示」で簡単に実現できます。

今回は、これを実現する関数を紹介します。

AutoFontSize関数

難易度:

標準モジュールのコード


標準モジュールに下記の関数を作成します。(コピーして貼り付けてください。)

追記 2013.07.19: バグがあったのでコードを修正しました。

誤)    arStr = Split(Str, vbCrLf, vbTextCompare)
正)    arStr = Split(Str, vbCrLf, -1, vbBinaryCompare)

使用例


レポートのテキストボックスの配置してあるセクションのフォーマット時イベントで、下記のように記述します。


レポートデザインビュー
フォームデザインビュー

第2引数は、フォントサイズの初期値です。数値で指定してください。
枠内に収まりきらないときは、収まるサイズまで縮小します。
ただし、Const MinFontSize = 4 で指定したサイズまでです。

対象コントロールは、テキストボックス、ラベルです。
改行有り、縦書き にも対応してます。

注:AC2000(無印)には、TextWidth メソッドにバグがあるため、
正常に動作させるには、サービスバックを適用する必要があります。

下記のこの関数の改良版がありますのでそちらもご参照ください。
AutoFontSize関数を垂直文字配置の指定ができるよう改良

サンプルファイルが下記からダウンロードできます。
RptAutoFontSize_07.zip (Access 2007-2010 形式 - 34kb)
RptAutoFontSize.zip (Access 2002-2003 形式 - 34kb)
RptAutoFontSize_2k.zip (Access 2000 形式 - 33kb)

拍手する

30 Comments

nanashi says..."すばらしい!"

もっと簡単にできるようにしてくれたいいのになぁ
よく使う機能だとおもうのだけど。

レポート内のテキストボックスすべてに対応するには
どのようにすればいいんでしょう~?
検索してみても、なかなか見つからない・・・

2009.04.23 11:44 | URL | #oyV.6EWY [edit]
nanashi says..."できた!!"

VBに詳しくないので自信なかったのですが
だめもとで

Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
AutoFontSize Me.テキストボックス名, 12
End Sub

この部分にテキストボックス名を追加したらできました。
hatenaさんありがとう!

2009.04.23 11:59 | URL | #oyV.6EWY [edit]
hatena says..."VBAを習得すると、、、"

Accessの基本操作とVBAの基礎的な知識はあるとの前提で書いていますので、初心者には難しい部分があるかもしれません。もし、VBAに興味を持たれたら、入門書を読まれるか、http://www.accessclub.jp/vba/ のような解説サイトで勉強されることをお勧めします。そうすると新しい世界が開かれるかも。。。。

> レポート内のテキストボックスすべてに対応するには
> どのようにすればいいんでしょう~?

すでにご自身で解決されたようですが、テキストボックスの数だけ繰り返し記述すればいいです。

Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
  AutoFontSize Me.テキストボックス1, 12
  AutoFontSize Me.テキストボックス2, 12
  AutoFontSize Me.テキストボックス3, 12
End Sub

2009.04.23 21:27 | URL | #5uE6dEgY [edit]
sss says...""

If H > .TextHeight("A") * (UBound(arStr) + 1) _

のところで構文エラーが出てしまうのですが・・・

2010.06.19 18:25 | URL | #- [edit]
hatena says..."構文エラー"

「クリップボードへコピー」ボタンをクリックしてコピーするか、「プレーン表示」ボタンで開いたページをコピーして、標準モジュールに貼り付けてください。

このページをそのままコピーすると余計な改行が入るので構文エラーになります。

2010.06.19 21:04 | URL | #5uE6dEgY [edit]
名無し says...""

分かりました!
有り難うございました。

2010.06.21 13:01 | URL | #- [edit]
シーズン特急 says..."いただきました"

当方で作成しているデータベースに使わせて頂きました。ありがとうございます(商用じゃないですよ)。
この機能は検索するといろいろヒットしますが、これが一番完成されていると思います。

2010.07.08 12:30 | URL | #- [edit]
vanson says..."素晴らしい!"

レポートでこの機能を探しておりまして大変助かりました!
素晴らしい情報をありがとうございます。

ところで、hatenaさんのレポートの「グループ内のデータを横連結する」の記事を拝見し活用させていただきました。
[名前1,名前2,名前3・・・]
という感じです。

それを一つのテキストボックスに文字連結をして、
[苗字]&[名前1,名前2,名前3・・・]
としました。

そのテキストボックスに、AutoFontSizeを適用したのですが
連結した状態で表示することができません。
何か解決策はあるのでしょうか?

お忙しいところお手数ですがhatenaさんの見解を聞かせていただけると幸いです。

2011.08.31 00:08 | URL | #- [edit]
hatena says..."横連結 & AutoFontSize"

連結テキストボックスにせずに、
非連結テキストボックスのままで、
下記のようにしたらどうでしょうか。

'グループフッターのフォーマット時イベント
Private Sub グループフッター2_Format(Cancel As Integer, FormatCount As Integer)
  Me.テキスト1 = Me!名字 & Mid(Me.テキスト1, 3)
  AutoFontSize Me.テキスト1, 12
End Sub


上記のイベント以外は「グループ内のデータを横連結する」と同じように。

また、「名字」フィールドは非表示のテキストボックスとして配置しておきます。

2011.08.31 14:23 | URL | #5uE6dEgY [edit]
まっぷっぷ says...""

こんにちわ。

テキストボックスがNULLだとエラーになるようなのですが
回避できませんでしょうか?

2012.03.19 11:17 | URL | #oyV.6EWY [edit]
hatena says..."re: まっぷっぷ さん"

Nullでもエラーにならないように作ってあるのですが。

具体的にどの行でエラーになりますか。
また、その時のエラーメッセージは?

2012.03.19 11:33 | URL | #5uE6dEgY [edit]
まっぷっぷ says..."re: hatenaさん"

早速のお返事ありがとうございます。
エラーは・・・

With rpt

If Ctr.ControlType = acTextBox Then
Str = Ctr.Text ← ここで出ています
ElseIf Ctr.ControlType = acLabel Then
Str = Ctr.Caption
Else
--------

hatenaさんがコメントで記述しておられる
「'ここでエラーが出る場合は、Str = Nz(Ctr.Value,"") 」は
試していません。これでしょうか?

エラーは「このプロパティの値を取得できません」となります。
デバッグボタンを押すと、上記エラーの箇所へ移動します。
問題のテキストボックスには、iif関数が入っており、
Aの場合はB、そうでない場合はCという条件です。
このAの場合はBの時、BがNULLであることがあります。

お手数ですが宜しくお願いいたします。

2012.03.19 14:24 | URL | #oyV.6EWY [edit]
まっぷっぷ says..."RE: hatenaさん"

連投すみません。
やはり、Str = Nz(Ctr.Value,"")ですね。

先のコメントを書き込む前にテストすればよかったです。
書き込んでからテストしてしまいました・・・
すみません。
問題なく表示できました。お騒がせしてすみません。

2012.03.19 14:29 | URL | #oyV.6EWY [edit]
はた says..."Access2007での使用"

以前より便利に使わせていただいております。ありがとうございます ^^
このたびAccess2007でレポートを作成しておりまして、この関数を使用したいのですが、
うまくいきません、2007では動作しないのでしょうか?

2012.03.20 16:20 | URL | #HrEnhfvM [edit]
hatena says..."re:Access2007での使用"

Access2007でも問題なく動作するはずです。

具体的にどのようにうまくいかないのでしょうか。

2012.03.20 16:46 | URL | #5uE6dEgY [edit]
はた says..."Access2007での使用"

お返事ありがとうございます。
レポートビューだと縮小表示されてないのですが、印刷プレビューだと縮小されました。
ただ1ページ目は表示されるのですが、改ページしようとすると
”実行時エラー 2196 このプロパティの値を取得できません”とでます。

2012.03.20 21:09 | URL | #- [edit]
はた says..."Access2007での使用"

すいません、今確認したところ

Str = Nz(Ctr.Value, "") 'ここでエラーが出る場合は、Str = Nz(Ctr.Value,"")

この部分を訂正したら、印刷プレビューでエラーがなくなりました。
ただ、レポートビューではやはり縮小表示されません。なぜでしょうか?

2012.03.20 21:12 | URL | #- [edit]
hatena says..."re:Access2007での使用"

> ただ、レポートビューではやはり縮小表示されません。なぜでしょうか?

レポートビューではフォーマット時イベントが発生しないというのが、Accessの仕様だからです。

2012.03.20 22:49 | URL | #5uE6dEgY [edit]
はた says..."re:re:Access2007での使用"

すいません、その通りですよね。失礼しました。
おかげさまで問題なく使用させていただけました。
ありがとうございます。

2012.03.22 01:27 | URL | #- [edit]
arimama819 says..."感動です、感謝します!!!"

某質問サイトよりこちらのHPを知りました。
早速試してみた所漢字と数値が混在していても全然問題なく、以前より見やすいフォントで印刷することが出来て感謝感謝です。

2012.10.26 18:02 | URL | #- [edit]
50の手習い says..."ありがとうごさいました"

マイクロソフトもhatenaさんのHPを参考に改良してほしいですね。
いつも助かります。

2013.02.08 14:55 | URL | #- [edit]
tenchan says..."コンパイルエラー "

「R_仕入先_はがき」で
全部のテキストで文字を1行におさめようと、以下のようにプロシージャを作成しましたが、

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)


AutoFontSize Me.[_Address_sub1], 16
AutoFontSize Me.[_Address_sub2], 16
AutoFontSize Me.[_Company], 22
AutoFontSize Me.[_Section], 13
AutoFontSize Me.[_Name], 22

End Sub


AutoFontSize Me.[_Name], 22
の行のところで「コンパイルエラー 型が一致しません」というエラーが出ます。
回避するにはどうすればいいでしょうか?

2013.04.06 16:17 | URL | #- [edit]
hatena says..."re:コンパイルエラー "

「_Name」というのはフィールド名で、テキストボックスの名前は別になっているとかはありませんか。

それ以外では、実物をみないと、思い当たるものがありません。

2013.04.06 17:44 | URL | #5uE6dEgY [edit]
tenchan says..."Re.コンパイルエラー"

早速のご返事ありがとうございます。
私の目指しているはがきの宛名印字に利用できないかと、解決に期待しています。

ご指摘の実物はRptAutoFontSize.accdbの中のレポートの「R_仕入先_はがき」にあり、プロパティシートの「名前」が_Nameになっています。
ダウンロードしたもので利用しています。

宜しくお願いします。

2013.04.07 07:17 | URL | #- [edit]
hatena says..."Re.コンパイルエラー"

RptAutoFontSize.accdb で試してみたら同じ現象を再現出来ました。

いろいろためしてみると、どうも _Name という名前が原因のようです。

テキストボックスの名前を txtName に変更して、コードも

AutoFontSize Me.[txtName], 22

としたらコンパイルが通り、正常に動作しました。

Name というのは、プロパティ名と重複するのでダメなのは想像つきますが、_を付けてもコンパイルエラーになるというのは、不思議な現象ですね。

2013.04.07 08:28 | URL | #5uE6dEgY [edit]
tenchan says...""

エラーが出なくなったのを確認しました。
ご指摘の理由も納得し、スッキリとしました。

今後RptAutoFontSize.accdb をもとに活用して、勉強していきたいと思います。
ありがとうございました。

2013.04.07 09:58 | URL | #- [edit]
いがちゃん says..."縦書きにしたいのですが"

hatenaさん、こんにちは。大変お世話になっております。レポートに住所、建物というテキストボックスを配置して縦書きに設定しているのですが文字が尻切れトンボになってしまうのでkonoAutoSizeFontを使ってみたのですが変わらずでした。そこで朝知恵ではありますが "Width" と "Height" を入れ替えて下記のようにしたのですが変わらずでした。何か良い方法はありますか?

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 'ここでエラーが出る場合は、Str = Nz(Ctr.Value,"")
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, -1, vbBinaryCompare)
Str = arStr(0)
For i = 1 To UBound(arStr)
'If .TextWidth(arStr(i)) > .TextWidth(Str) Then Str = arStr(i)
If .TextHeight(arStr(i)) > .TextHeight(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
If W > .TextHeight(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

2015.02.17 16:24 | URL | #- [edit]
hatena says..."re: 縦書きにしたいのですが"

AutoFontSizeは縦書きにも対応してます。

テキストボックスの「縦書き」プロパティを「はい」にしてますか。

2015.02.17 17:53 | URL | #5uE6dEgY [edit]
いがちゃん says..."Re:"

はい。縦書きになっています。Num2KanjiNumを使って数字を漢数字に替えていることとかは影響ありますか?

2015.02.17 21:53 | URL | #- [edit]
いがちゃん says..."できました。"

hatenaさん、テキストボックスのプロパティーでフォントサイズを空欄にしたら縮小して表示されました。ご迷惑をかけました。

2015.02.17 22:01 | URL | #- [edit]

Leave a reply






Trackbacks

trackback URL
http://hatenachips.blog34.fc2.com/tb.php/11-043f6268
該当の記事は見つかりませんでした。