Excelで最小フォントサイズを取得したい

質問

会社でExcel2000、自宅でExcel2003を使用しております。
仕事でExcelを使って表を作成しているのですが、
フォントサイズを印刷倍率に気をつけながら作成しなければなりません。
その際に、VBAを使って下記のようなことは出来ないでしょうか？

1：表の範囲を選択する（印刷範囲を選択するような感じで。なぜなら、表中のデータはその時その時でどこから始まりどこで終わるかが異なっているからです）

2：表中に使われてる最小フォントサイズを取得する。
（その際、印刷倍率と実際使用されているフォントサイズを考慮。例えば倍率が90パーセント、フォントサイズが10の時は10×90％＝9ポイント、というふうに）
※この際、もし表中に上付き文字などが入っていた場合、上付き文字のサイズは無視する。

ちなみに、表は以下のようなものです。
（実際には「-」の部分に数値が入っている事もあります。）

Table1
---------------------------------------------------
Day 　　1 2 3 4 5 6 7 8 9 10 11 12 13
---------------------------------------------------
Date　　- - - - - - + - * - - - - - -
---------------------------------------------------

*=an exception

当方、VBAは初心者です。
（記録～初歩的な構文は理解できます）

とても困っております。
どうぞよろしくお願い致します。

回答No.1

nishi6 · ベストアンサー

なぜフォントサイズを気にする必要があるか分かりませんが、困っておられるようなので、質問のマクロを書いてみました。
調べたい範囲を選択して、下のマクロを実行して下さい。

最小フォントサイズ：11
印刷倍率：90％
倍率考慮：９

のようなメッセージボックスを表示します。

１つのセル内のフォントが複数ある場合は無視しています。
モジュールの
　　'// 複数のフォントサイズが設定されている場合
　　'//　　　・・・何もしていない
　　'　　：
　　'　　：
の部分です。
For～Nextの『'』を削除すると、それなりに動くはずですが、意味があるかどうかは分かりません。
まずは、下のまま動かしてみてください。標準モジュールに貼り付けます。

Sub getMinimumFontSize()
　　Dim rg As Range　　　　　'// セル
　　Dim minFS As Integer　　 '// フォントの最小サイズ
　　Dim L As Integer　　　　 '// 文字カウンタ

　　minFS = 409　'// これが最大値(Excel2000)
　　For Each rg In Selection
　　　　'// 入力のあるセルのみを対象とする
　　　　If rg.Text <> "" Then
　　　　　　If IsNull(rg.Font.Size) Then
　　　　　　　　'// 複数のフォントサイズが設定されている場合
　　　　　　　　'//　　　・・・何もしていない
　　　　　　　　'For L = 1 To Len(rg.Text)
　　　　　　　　'　　If rg.Characters(L, 1).Font.Size < minFS Then
　　　　　　　　'　　　　minFS = rg.Characters(L, 1).Font.Size
　　　　　　　　'　　End If
　　　　　　　　'Next
　　　　　　Else
　　　　　　　　'// セルには単一のフォントサイズ
　　　　　　　　If rg.Font.Size < minFS Then
　　　　　　　　　　minFS = rg.Font.Size
　　　　　　　　End If
　　　　　　End If
　　　　End If
　　Next

　　'// メッセージ出力(計算によっては、倍率考慮＝0 も出る)
　　MsgBox "最小フォントサイズ：" & minFS & vbLf & _
　　　　　 "印刷倍率：" & ActiveSheet.PageSetup.Zoom & "%" & vbLf & _
　　　　　 "倍率考慮：" & Int(minFS * ActiveSheet.PageSetup.Zoom / 100)

End Sub

お礼

ありがとうございます！
望みどおりのものができました。

＞なぜフォントサイズを気にする必要があるか
実は、このような表を作成して顧客へ配布するのですが、
顧客の会社ごとによって使用できる最小フォントサイズが決まっており、しかも表が膨大になった場合、どうしても縮小をかけて表を作成して、それをいちいち計算してCKして・・・と大変だったもので、
どうにかVBAでクリアできないものかと日々悩んでおりました。

本当にありがとうございました！