VBAで条件によりフォントサイズを自動で変更したい２

こんにちは。
マクロやVBAの知識が乏しいため非常に困っています。

エクセルにてシート（１）から
文字をとっているシート（２）があるのですが
文字数が多くなるとシート（２）のほうがセルからはみ出てしまいます。

そこで文字数でフォントサイズを変更したいと考えました。
１９文字以上ならサイズを１４に。。という具合に自動でできるコードを
ご教授願えないでしょうか？
よろしくお願いします。
また、それ以外に良いものがあればそれを採用したいとも考えています。

以下条件になります。
シート（１）のA1の文字が１５文字以下ならシート（２）のB2のサイズを１８に

シート（１）のA1の文字が１６文字以上ならシート（２）のB2のサイズを１６に

シート（１）のA1の文字が１９文字以上ならシート（２）のB2のサイズを１４に

シート（１）からシート（２）へ文字を反映している箇所が4か所
その4か所を1番長い文章のフォントサイズで統一したい。

No.3 ベストアンサー 回答者： WindFaller 回答日時： 2018/10/05 23:56

こんばんは。

前回のコードを直してみました。
Sheet1のマクロ画面に、上書きして試してください。
すでに書かれている場合は、1列目にどこかで、Enter を入れれば、このコードは可動します。
ただ、これが自動制御でなければ、ボタンにして可動するようにしてしまうことも良いかと思います。

'//シートモジュール
Private Sub Worksheet_Change(ByVal Target As Range)
Dim fnt As Integer
Dim opRng As Range
Dim maxLen As Long '最大の文字長
Dim c As Range
With Worksheets(2)
Set opRng = .Range("B2", .Cells(Rows.Count, "B").End(xlUp)) '対象のセル群
If WorksheetFunction.CountA(opRng) = 0 Then Exit Sub '対象セル群の文字列等が一切ない場合
End With
If Target.Column <> 1 Then Exit Sub '1列目以外は除外
If Target.Count > 1 Then Exit Sub '複数のセルの時除外
If Target.Value = "" Then Exit Sub '空白または削除では作動しません。
For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))
If c.Value > "" Then
　 If maxLen < Len(c.Value) Then
　 maxLen = Len(c.Value)
　 End If
　End If
Next
Select Case maxLen
　Case Is >= 19: fnt = 14
　Case Is >= 16: fnt = 16
　Case Is >= 1: fnt = 18
End Select
opRng.Font.Size = fnt
End Sub

この回答へのお礼

お世話になります。
前回からありがとうございます。
前回は文字サイズの統一が抜けてしまっていて
二度手間になって申し訳ないです。

お礼日時：2018/10/09 13:21

No.4 回答者： ママチャリ 回答日時： 2018/10/07 20:55

みやたろすさん、文書の説明と画像の内容に矛盾があるようですが、大丈夫ですか？

Sheet2のA2、A5、A8、A10に表示されている文字数によって、同セルのフォントサイズを決定すれば良いのですよね。また、同セルは、数式でSheet1を参照しているのですよね。であれば、Sheet2のCalculateイベントプロシジャに下記のコードを仕込むのが良いと思います。

Private Sub Worksheet_Calculate()
Dim myRng As Range
Dim r As Range
Dim maxLen As Long
Set myRng = Me.Range("A2,A5,A8,A10")
For Each r In myRng
If Len(r.Text) > maxLen Then maxLen = Len(r.Text)
Next r
Select Case maxLen
Case Is <= 15
myRng.Font.Size = 18
Case Is >= 19
myRng.Font.Size = 14
Case Else
myRng.Font.Size = 16
End Select
End Sub

この回答へのお礼

こんにちは
回答ありがとうございます。
本当ですね。気づきませんでした（汗

お礼日時：2018/10/09 13:17

No.2 回答者： satoumasaru 回答日時： 2018/10/05 18:00

Do Loop文で文字数をカウントして、if then とか　Cells.Font.Size　でやれば可能です。

しかし 「マクロやVBAの知識が乏しい」とおっしゃっておられるなら、書式設定でされる方がよいですよ。

この回答へのお礼

回答ありがとうございます。
書式設定だけですむのであればそうしたいのですが
すべてのサイズを統一しようとするとできなかったので
質問させて頂いた次第です。

お礼日時：2018/10/09 13:23

No.1 回答者： よろずやkinchan 回答日時： 2018/10/05 17:29

VBAなんぞ使わなくても、書式設定ｰ配置ｰ文字の制御ｰ縮小して全体を表示する

で出来ますけど。

この回答へのお礼

回答ありがとうございます。
縮小して表示すると文字サイズがばらばらになるため
使用できないので質問させて頂きました。

お礼日時：2018/10/09 13:24