Ｅｘｃｅｌでセルのフォントを自動で変更したい

質問

Ｅｘｃｅｌで罫線でかこまれた用紙に印字する際、下記のようなことができると作業が楽になります。
シート1には印刷用フォーマット（行幅列幅ともに固定）があり、シート2には（ＶＬＯＯＫＵＰでシート1の該当セルに参照されるための）データが入っています。
例：　シート2のA1（製品名）の内容はシート1のA1にVLOOKUPで参照されるとして…
シート2のA1に入れた文字数が既定を超えると、文字が切れた状態で印字がなされます。
現在はそれを避けるために、文字が収まるＯＲ収まらないの判断を（当たりまえですが）人の目でおこなっています。
シート2で入力後にシート1を開いてその都度フォントサイズを変更して印刷。
入力→人間の目で判断→フォントサイズの変更→印刷、入力→また人間の目で判断→フォントサイズの変更→印刷、入力→またまた人間の目で・・・の繰り返しです。
作業効率のわるさを感じますし、印刷用のフォーマット（シート1）とデータ入力（シート2）が別々なので、シート間を行き来するのも手間なのです。
入力した桁数が既定を超えたとき、列幅や段組を変えずにフォントサイズだけを小さくし、次に既定内の文字が入ったときはそれに対応するフォントになる、というようなことを自動でおこない、現在の当たりまえを変えたいのです。
半角を1単位＝1桁
例：　シート2のA1（製品名）の内容はシート1のA1にVLOOKUPで参照されるとしてシート1のA1のフォントサイズが
【例 1】25桁以下ならフォントサイズ16
【例 2】26桁以上30桁以下ならフォントサイズ14
【例 3】31桁以上ならフォントサイズ12
というような設定を自動でおこなうことは可能でしょうか。

過去の質問も検索しましたが、さがし方がうまくないようで、道に迷いこの時間です…。
VBAのことはよくわかりません。
が、この作業が楽になるならＡｌｔ＋F11で貼り付けますので、よろしくお願いします。

回答No.4

Wendy02 · ベストアンサー

こんにちは。Wendy02です。

＞書式が文字列になるようで、数式の結果でなく式そのものがただの文字列で返されてしまいます。

それは、一種の仕様ですね。

参照元の書式の「文字列」が、被参照側の書式に延長されてしまう現象です。VBAの問題ではありませんが、VBAで処理することは可能です。

その現象を実現させてみます。

　例えば、書式を「文字列」にして、A1に「あ」と入れます。

次に、B1 に、=B1 と入れますと、一度は、「あ」と出ますが、その式の部分を、ファンクションキーの[F2]を押して、[Enter]を入れると、=A1 となってしまいます。

その時に、セルの書式設定の表示形式　タブをみると、B1 のところは、「文字列」となっているはずです。書式が、延長されました。

また、A2 に、=A1 とやってみても同じようになるはずです。

つまり、参照元の書式の「文字列」を使ったセルを、式の参照させるということが問題なのです。書式の文字列は、ある意味でトラブルメーカーのようなもので、その代用としては、「'」という、Prefix(接頭辞）を使うのですが、これも、根本的に解決する方法ではありません。

これは、どなたのExcelでもある現象かと思います。もう一度、数式が書式「文字列」になってしまったものを、こまめに標準などに戻していただく以外は、その直す方法は、今のところわかりません。

ただ、VBAのコードですが、そういう問題に対処するためには、以下のようなものになります。該当するセルを1つずつ、標準書式に戻しています。

'----------------------------------------------------
Sub AlternateFontSizesR()
　 '数式で文字列になってしまう現象に対して修正を加える
　 Dim rng As Range
　 Dim c As Range

　 Set rng = Selection
　 Application.ScreenUpdating = False
　 For Each c In rng
　　 If c.Text Like "=*" Or c.FormulaLocal Like "=*" Then
　　　　　c.WrapText = False
　　　　　c.NumberFormat = "General"
　　　　　c.FormulaLocal = c.FormulaLocal
　　　Select Case LenB(StrConv(c.Text, vbFromUnicode))
　　　'フォントの調整はここでしてください。
　　　　 Case Is <= 25　'25文字以下は、Font16
　　　　　 'c.ShrinkToFit = True
　　　　　 　c.Font.Size = 16
　　　　 Case Is >= 26
　　　　　　c.ShrinkToFit = True　'縮小
　　　End Select
　　 ' c.FormulaLocal = c.FormulaLocal
　　　End If
　 Next c
　 Set SpRng = Nothing: Set rng = Nothing
　 Application.ScreenUpdating = True
　 MsgBox "終了しました!"
End Sub
'----------------------------------------------------

お礼

こんばんは。
Wendy02さん、ご回答ありがとうございます。

Wendy02さんの説明で、Excelが壊れていなかったことに安堵するとともに、これまでセル参照機能を使ってよくこの問題にひっかからなかったもんだなぁ…などとあらためて思いました。
その程度の使い方しかしていないのですが…。
書式設定のなかに「文字列」があるにもかかわらず、わざわざセルの頭に「'」を入れて文字列にさせる「'」の役目？もなんとなくわかりました。

ありがとうございました。

回答No.3

Wendy02

こんにちは。

昨日から、しばらく考えてみました。なかなか、満足させられる形にするのは難しいような気がします。理屈やロジックでは割り切れない部分があります。

前のお二方がおっしゃるように、「縮小して全体を表示する」は、確かに有効なのですが、いずれにしても、いつも変るものに対して、それは手作業ではとても面倒だ、というのが、ご質問のご主旨だと承りましたし、それはごもっともだと思います。

また、連結セルなどがある場合は、また、以下の条件が変わってくるような気がしますが、コードを考えてみました。

もし、「縮小して全体を表示する」にするようでしたら、以下の間を、

　　　Select Case LenB(StrConv(c.Text, vbFromUnicode))
　　　'フォントの調整はここでしてください。
　　　　 Case Is <= 25
　　　　　　c.Font.Size = 16
　　　　 Case 26 To 30
　　　　　　c.Font.Size = 14
　　　　 Case Is >= 31
　　　　　　c.Font.Size = 12
　　　End Select

を以下の

　c.ShrinkToFit = True
だけにすればよいと思います。

フォーム・ツールのボタンで以下を登録してください。

以下のコードは、数式にしか働きません。

'標準モジュール
'-------------------------------------------

Sub AlternateFontSizes()
　 '数式の戻り値のフォントサイズをフォントの桁により変更する
　 Dim rng As Range
　 Dim SpRng As Range
　 Dim c As Range

　 Set rng = ActiveSheet.UsedRange
　 On Error Resume Next
　 Set SpRng = rng.SpecialCells(xlCellTypeFormulas)
　 If SpRng Is Nothing Then Exit Sub
　 On Error GoTo 0

　 Application.ScreenUpdating = False
　 For Each c In SpRng.Cells
　　　　　c.WrapText = False
'-----------交換場所-----------------------
　　　Select Case LenB(StrConv(c.Text, vbFromUnicode))
　　　'フォントの調整はここでしてください。
　　　　 Case Is <= 25
　　　　　　c.Font.Size = 16
　　　　 Case 26 To 30
　　　　　　c.Font.Size = 14
　　　　 Case Is >= 31
　　　　　　c.Font.Size = 12
　　　End Select
'------------------------------------------
　 Next c
　 Set SpRng = Nothing: Set rng = Nothing
　 Application.ScreenUpdating = True
　 MsgBox "終了しました!"
End Sub

'おまけ(場合によっては必要なはずです）
Sub RecoverFontSizes()
　 '数式の戻り値のフォントサイズを戻す
　 Dim rng As Range
　 Dim SpRng As Range
　 Dim RegFontSize As Double
　 Dim c As Range
　 Set rng = ActiveSheet.UsedRange
　 RegFontSize = ActiveWorkbook.Styles("Normal").Font.Size
　 On Error Resume Next
　 Set SpRng = rng.SpecialCells(xlCellTypeFormulas)
　 If Not SpRng Is Nothing Then

　　　If MsgBox("数式のフォントの大きさを標準に戻しますがよろしいですか？" & vbCrLf & _
　　　　 " フォントの標準 : " & CStr(RegFontSize), vbOKCancel) = vbOK Then
　　　　 ActiveSheet.Cells.Rows.RowHeight = ActiveSheet.StandardHeight
　　　End If

　　　On Error GoTo 0

　　　Application.ScreenUpdating = False
　　　For Each c In SpRng.Cells
　　　　 c.Font.Size = RegFontSize
　　　Next c
　　　Application.ScreenUpdating = True
　　　Else
　　　If MsgBox("このシートには数式がありませんので、セルの全体を標準に戻しますがよろしいですか？" & vbCrLf & _
　　　　 " 標準のフォントサイズ : " & CStr(RegFontSize), vbOKCancel) = vbOK Then
　　　　 Application.ScreenUpdating = False
　　　　　　ActiveSheet.Cells.Font.Size = RegFontSize
　　　　 Application.ScreenUpdating = True
　　　End If
　 End If

　 If MsgBox("セルの高さを標準に戻しますがよろしいですか？" & vbCrLf & _
　　　" 標準の高さ : " & CStr(ActiveSheet.StandardHeight), vbOKCancel) = vbOK Then
　　　ActiveSheet.Cells.Rows.RowHeight = ActiveSheet.StandardHeight
　 End If
　 Set SpRng = Nothing: Set rng = Nothing
　 MsgBox "終了しました。!"
End Sub

補足

長い構文を考えてくださりありがとうございました。
また、文章から操作過程での心の嘆きを汲みとってくださった、Wendy02さんの細やかさがうかがわれました。
下記の通り、質問は縮小して解決になったのですが、Wendy02さんのVBAも貼り付けて試したところ、疑問が浮かびました。

VBAが書かれているシートでは数式が入力してあるセルをダブルクリックすると、書式が文字列になるようで、数式の結果でなく式そのものがただの文字列で返されてしまいます。
私のパソコンだけでしょうか？？？
かれこれ2時間くらい格闘しているのですが、また迷子になってます。
簡単に考えるため
【シート1】A1に=B1と数式を入れて、B1には「あ」と入れたもの
【シート2】A1に=B1と数式を入れて、B1には「あ」と入れたもの ＆ ALT＋F11で上記VBAを貼り付ける
シート2のA1をダブルクリックして編集可能にしたあとEnterを押すと「あ」が表示されてるのに、シート1では同じ操作で「=B1」が表示されます。
セルの書式設定の分類も、シート2の方は標準のままなのに、シート1ではどこも選択されないのです。

本題からかなり逸れた質問なのですが、VBAが関わるとそうなるものなのか、私の勘違いなのか、無知なクセにALT＋F11をいじってExcelがこわれたのか…もうよくわからないのです。
これをご覧になってご回答いただけるようでしたら、急ぎませんので返信をよろしくお願いします。

回答No.2

noname#204879

[書式]→[セル]→[配置]の“縮小して全体を表示する”を適用するのが簡単かと。
これだと、実際に印刷させると右端が途切れる、というような いわゆるプリンタドライバとの相性問題も発生しません。

お礼

早速の回答ありがとうございます。
この機能をすっかり忘れていました。
知識のつまった過去回答から似たものをさがして所々手を加えれば解決するかもしれない、そう考えるあまり煮詰まって基本を見落としていました。
「縮小して全体を表示する」は活用したことがあります。
肩が張っていました。
解決です。
ありがとうございます。

回答No.1

te12889

「セルの書式設定」の「配置」タブに「縮小して全体を表示する」ってのがありますが、お試しなったことはありますか？

参考URL：

http://www.jpita.or.jp/hpv3/ziten/mokutekibetu/ex_60.html

お礼

早速の回答ありがとうございます。
それが使えたのですね。
知識のつまった過去回答から似たものをさがして所々手を加えれば解決するかもしれない、そう考えるあまり煮詰まって基本を見落としていました。
「縮小して全体を表示する」は活用したことがあります。
肩が張っていました。
解決です。
ありがとうございます。