Post-Admin:
Date: 2006年 05月 10日
Subject:
Excelでセル内の全体を表示する
セルの書式で「折り返して全体を表示する」と「縮小して全体を表示する」に両方チェックが入っている場合にそれを同時に実現する。
5/10 11:00 変更した
Private Sub Worksheet_Change(ByVal target As Range)
Dim c
Dim orgHeight, orgWidth, orgSize
Dim tmpSize, minSize, maxSize
'On Error GoTo lErr
On Error Resume Next
Application.EnableEvents = False
For Each c In target
If c.WrapText And c.ShrinkToFit Then
orgHeight = c.Height
orgWidth = c.Width
orgSize = c.Font.Size
minSize = 1
maxSize = orgSize
If maxSize < 11 Then maxSize = 11
tmpSize = (minSize + maxSize) / 2
Do While Abs(maxSize - minSize) > 0.1
c.Font.Size = tmpSize
c.Rows.AutoFit
If c.Height > orgHeight Or tmpSize > orgWidth Then
maxSize = tmpSize
Else
minSize = tmpSize
End If
tmpSize = (minSize + maxSize) / 2
c.Rows.RowHeight = orgHeight
Loop
c.Font.Size = minSize
End If
Next
lErr:
Application.EnableEvents = True
End Sub
強引だし細かい調整をしていないのでいまいち。