★AccessVBA ～テキストボックスの大きさに合わせて文字を小さくする方法（横書き、縦書き）
※まだ書きかけです。すみません。
※間違ってたらすみません。
※メモ書きなので、自分でも意味不明な箇所も多いです。ごめんなさい。
32bitのAccessと64bitのAccessでは、作りが異なるので、それぞれ専用のmdbないし、accdb、を作ったほうがいいです。
特にAccessのハガキウィザードを使ったとき。
Win32APIを呼び出すのですが、64bitだと、それ専用に書き変えないとエラーになります。
64bitのAccessの場合は、もともと「Yubin7.dll」が無いこともあるのかもしれません。わかりませんが・・・。
以降にご提示した「テキストボックスの大きさに合わせて文字を小さくする」というプログラムは、そこには依存しないのであまり心配はないのですが、ただ、ハガキウィザードにて郵便番号や顧客住所などを自動で表示（あるいは印刷）するようなプログラムでは少し気をつけてください。
（ハガキウィザードが作ってくれたコードやテキストボックスを削らないといけないことがあります。）
★Accessのハガキウィザード作ったレポートのテキストボックスを、郵便番号以外を無効化する方法
（ウィザードで自動作成されたテキストボックスを消しても大丈夫にする方法）
詳細セクションのFormatイベントのコードを、
「Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)」
からすぐ下の変数宣言の部分は一応残しておいて、
あと、以下の部分だけも残して、あとは全部消すか、コメントアウトします。
If iStrp = 0 Then
rgchSBCSNum = "0123456789"
rgchDBCSNum = Chr$(-32177) & Chr$(-32176) & Chr$(-32175) & Chr$(-32174) & Chr$(-32173) & Chr$(-32172) & Chr$(-32171) & Chr$(-32170) & Chr$(-32169) & Chr$(-32168)
rgchKanjiNum = Chr$("-32422") & Chr$("-30486") & Chr$("-27663") & Chr$("-29105") & Chr$("-29076") & Chr$("-29476") & Chr$("-26534") & Chr$("-29003") & Chr$("-27478") & Chr$("-29725")
End If
レポートデザイン画面のテキストボックスは、氏名と住所と差出人のそれらは消すか、小さくして非表示氏にしてOKです。
郵便番号付近の小さなテキストボックスらしきものは、消すとエラーになるものは残しておき、非表示設定にします。
一度に全部消すと、エラーになるかもなので、１つ１つ、確認しながら消してください。
プログラム側を消してしまったので、「逆に残すとエラーになる」なんてこともあるかもしれません。
その場合は消してしまってください。
★横書きテキストボックスの場合の、プログラムの呼び出し方法
Accessのハガキウィザードで作ったDMなどは、例えば前項のように「全部消してしまった」部分に、以下のように書き足して縮小表示をします。
Call FontMinimize01(Me, Me("tbx_氏名"), 28)
ウィザードでのハガキ以外のレポートなら、好きな場所に書いて縮小表示を実行します。
なお、Meの部分は、レポートやフォームのオブジェクトそのものを指定します。
（ただ、基本、Meのままでいいです。もとからレポートかフォームでしか使えないプログラムなので）
「"tbx_氏名")」の部分は、縮小表示したいテキストボックスなどのコントロール名を書きます。
28、18、15、などのラスト部分の数字は、
「縮小表示したいテキストボックスななどの最大フォントサイズの上限設定値」です。
|
1 2 3 4 5 6 7 8 |
' ' Call FontMinimize01(Me, Me("tbx_氏名"), 28) Call FontMinimize01(Me, Me("tbx_住所01"), 18) Call FontMinimize01(Me, Me("tbx_住所02"), 15) ' ' |
★縦書きテキストボックスの場合の、プログラムの呼び出し方法
Accessのハガキウィザードで作ったDMなどは、例えば前項のように「全部消してしまった」部分に、以下のように書き足して縮小表示をします。
Call FontMinimize01_tete01(Me, Me("tbx_氏名"), 28)
ウィザードでのハガキ以外のレポートなら、好きな場所に書いて縮小表示を実行します。
こちらも、Meの部分は、レポートやフォームのオブジェクトそのものを指定します。
（ただ、基本、Meのままでいいです。もとからレポートかフォームでしか使えないプログラムなので）
「"tbx_氏名")」の部分は、縮小表示したいテキストボックスなどのコントロール名を書きます。
28、18、15、などのラスト部分の数字は、
「縮小表示したいテキストボックスななどの最大フォントサイズの上限設定値」です。
|
1 2 3 4 5 6 7 8 |
' ' Call FontMinimize01_tete01(Me, Me("tbx_氏名"), 28) Call FontMinimize01_tete01(Me, Me("tbx_住所01"), 18) Call FontMinimize01_tete01(Me, Me("tbx_住所02"), 15) ' ' |
★横書きテキストボックス用のプログラム（標準モジュールにコピペ）
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 |
' ' Sub FontMinimize01(o_Report01 As Report, o_tbx01 As TextBox, MAXFONTSIZE As Integer) Dim L1 As String Dim S1 As Single Dim S2 As Single Dim S3 As Single ' Dim MAXFONTSIZE As Integer '★追加 ' MAXFONTSIZE = 28 '★追加 S3 = 0.9 o_Report01.FontSize = o_tbx01.FontSize L1 = o_tbx01.Value '横書き用？ S1 = o_Report01.TextWidth(L1) S2 = o_tbx01.Width / S1 o_tbx01.FontSize = Int(o_tbx01.FontSize * S2 * S3) If o_tbx01.FontSize > MAXFONTSIZE Then '★追加 o_tbx01.FontSize = MAXFONTSIZE '★追加 End If '★追加 End Sub ' ' |
★縦書きテキストボックス用のプログラム（標準モジュールにコピペ）
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 |
' ' Sub FontMinimize01_tete01(o_Report01 As Report, o_tbx01 As TextBox, MAXFONTSIZE As Integer) Dim L1 As String Dim S1 As Single Dim S2 As Single Dim S3 As Single ' Dim MAXFONTSIZE As Integer Dim NewFontSize As Integer Dim CharCount As Long Dim i_BaseSize As Integer ' MAXFONTSIZE = 28 i_BaseSize = MAXFONTSIZE S3 = 0.85 ' ★毎回、基準のフォントサイズ（初期値）をレポート側にセットしてリセットします o_Report01.FontSize = i_BaseSize ' Null（空文字）対策 L1 = Nz(o_tbx01.Value, "") If L1 = "" Then o_tbx01.FontSize = i_BaseSize ' 空のときは元のサイズに戻す Exit Sub End If ' 文字数をカウント（改行コードを取り除く） Dim cleanStr As String cleanStr = Replace(Replace(L1, vbCr, ""), vbLf, "") CharCount = Len(cleanStr) If CharCount = 0 Then o_tbx01.FontSize = i_BaseSize Exit Sub End If ' 「"あ" という文字1文字の高さ」に「文字数」を掛け算 ' ※基準サイズ（i_BaseSize）の状態での「あ」の高さを正しく取得します S1 = o_Report01.TextHeight("あ") * CharCount ' テキストボックスの「高さ(Height)」と「文字全体の高さ(S1)」を比較 S2 = o_tbx01.Height / S1 ' 文字が少ないときに巨大化するのを防ぐため、倍率は最大1（等倍）にする If S2 > 1 Then S2 = 1 ' ★【修正】書き換わってしまったフォントサイズではなく、常に「i_BaseSize」を基準に計算します NewFontSize = Int(i_BaseSize * S2 * S3) ' 最大フォントサイズ（28）を超えないように制限 If NewFontSize > MAXFONTSIZE Then NewFontSize = MAXFONTSIZE End If ' 小さくなりすぎないよう最低値（5pt）を担保 If NewFontSize < 5 Then NewFontSize = 5 End If ' 計算された安全なサイズをテキストボックスに適用 o_tbx01.FontSize = NewFontSize End Sub ' ' |
★DMハガキ用。数字を漢数字に変換する。
Accessのハガキ印刷の宛名印刷の場合、テキストボックスのコントロールソースで使います。
例
=SafeToKanjiNum(StFixDashCharForVert([住所1]))
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 |
' ' Public Function SafeToKanjiNum(ByVal TargetStr As String) As String ' ------------------------------------------------------------------------- ' 機能：文字列内の半角・全角数字を、安全に漢数字（一二三...）に変換する ' 引数：TargetStr = 変換対象の文字列（Nullや空文字でもエラーになりません） ' ------------------------------------------------------------------------- On Error GoTo ErrorHandler ' 引数が空（文字数ゼロ）またはNullの場合は、そのまま空文字を返して安全に終了 If Len(TargetStr & "") = 0 Then SafeToKanjiNum = "" Exit Function End If Dim i As Long Dim checkChar As String Dim resultStr As String ' 文字列を1文字ずつチェックして変換 For i = 1 To Len(TargetStr) checkChar = Mid(TargetStr, i, 1) Select Case checkChar ' 半角数字、または全角数字の場合に漢数字へ置換 Case "0", "０": resultStr = resultStr & "〇" Case "1", "１": resultStr = resultStr & "一" Case "2", "２": resultStr = resultStr & "二" Case "3", "３": resultStr = resultStr & "三" Case "4", "４": resultStr = resultStr & "四" Case "5", "５": resultStr = resultStr & "五" Case "6", "６": resultStr = resultStr & "六" Case "7", "７": resultStr = resultStr & "七" Case "8", "８": resultStr = resultStr & "八" Case "9", "９": resultStr = resultStr & "九" ' 数字以外（漢字、ひらがな、アルファベット、ハイフン等）はそのまま結合 Case Else resultStr = resultStr & checkChar End Select Next i SafeToKanjiNum = resultStr Exit Function ErrorHandler: ' 万が一予期せぬエラーが起きた場合は、システムを止めずに元の文字列をそのまま返す SafeToKanjiNum = TargetStr End Function ' ' |
★DMハガキ用。ハイフンを縦書きハイフンに変換する。
|
1 2 3 4 5 6 |
' ' ' ' |
