Adjustable Font Size
Hi Darren,
I've made a start but best I can say about this (below) is it's work in
progress, in particular not reliable with very long strings over about 1500.
But see how you get on.
- copy the merged area to a temp cell in a totally empty column in say a
hidden sheet
- unmerge the temp cell
- set tmp cell's width to same as merged area's width (see colWd)
- autofit the temp cell's row height
- compare row heights, if temp row height is larger reduce the font size and
autofit until it's same height or less, but bail out if font size reduces to
say 3
- report font size
Sub Setup()
Dim s1$, s2$
s1 = "Some text of unknown width. "
Do While Len(s2) < 1000
s2 = s2 & s1
Loop
s2 = s2 & " END"
With Worksheets("Sheet1").Range("A1")
.WrapText = True
.Resize(10, 7).MergeCells = True
.Value = s2
End With
End Sub
Sub test()
Dim colWd As Single
Dim FntSize As Single
Dim rCheck As Range, rTmp As Range, rCol As Range
Dim ws As Worksheet, wsTmp As Worksheet
Set ws = Worksheets("Sheet1")
Set wsTmp = Worksheets("Sheet2") ' say a hidden sheet
Set rCheck = ws.Range("A1").MergeArea
Set rTmp = wsTmp.Range("A1")
rTmp.Columns.ClearContents
rCheck.Copy rTmp
For Each rCol In rCheck.Columns
colWd = colWd + rCol.ColumnWidth
Next
rTmp.MergeCells = False
rTmp.ColumnWidth = colWd
rTmp.Rows(1).EntireRow.AutoFit
FntSize = rTmp.Font.Size
Do
If rTmp.Height rCheck.Height Then
FntSize = rTmp.Font.Size
FntSize = FntSize - 0.75
rTmp.Font.Size = FntSize
rTmp.Columns(1).EntireRow.AutoFit
Else
Exit Do '
End If
Loop Until FntSize < 3
Debug.Print "Font size " & FntSize
' rTmp.ClearContents
End Sub
I first tried fixing the row height to same as merged area's height and
autfitt'ing the width, but that seems less reliable than fix width then
autofit height until OK.
Regards,
Peter T
"Darren Hill" wrote in message
...
I'm using Excel 2003 & 2007, on WinXP2.
I have a large cell (a merged cell 7 columns wide by 10 rows high).
This cell can contain a lot of wrapped text.
What I need is some way to check if the string can't all be displayed at
the current font size, and what size to dynamically reduce the font size
to, to make it fit.
Basically, I need a function that will check the text in a merged cell,
and report the font size needed to make all the text visible. Is that
possible?
Thanks,
Darrem
|