Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adjustable Font Size
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adjustable Font Size
Fantastic!
The cells rarely contain more than 500 characters, but can be up to 1000 or so, so I shouldn't hit that problem limit. Can I ask: why does the font size reduce in 0.75 increments? I thought I'd read font size was in 0.5 increments. Thanks, Darren Peter T wrote: 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adjustable Font Size
Well that's a turn up !
Have you tested to a string length where it starts to become unreliable, if so what ( in Setup(), Do While Len(s2) < 1000 ' increase ) Can I ask: why does the font size reduce in 0.75 increments? In my system I've always noticed Font size increases in 0.75 increments. If say the Font size shows '10' on the toolbar it cell.Font.Size returns 9.75. Actually quite a lot of other points type dimensions also appear to increment in steps of 0.75. This might be related to my 'typical screen' res, not sure. Regards, Peter T "Darren Hill" wrote in message ... Fantastic! The cells rarely contain more than 500 characters, but can be up to 1000 or so, so I shouldn't hit that problem limit. Can I ask: why does the font size reduce in 0.75 increments? I thought I'd read font size was in 0.5 increments. Thanks, Darren Peter T wrote: 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adjustable Font Size
I have just returned a Font Size of 7.75, not sure now it's such a good idea
to increment 0.75. Might be better to change to steps of 0.25. In the Do loop change - FntSize = FntSize - 0.75 to FntSize = FntSize - 0.25 Peter T "Peter T" <peter_t@discussions wrote in message ... Well that's a turn up ! Have you tested to a string length where it starts to become unreliable, if so what ( in Setup(), Do While Len(s2) < 1000 ' increase ) Can I ask: why does the font size reduce in 0.75 increments? In my system I've always noticed Font size increases in 0.75 increments. If say the Font size shows '10' on the toolbar it cell.Font.Size returns 9.75. Actually quite a lot of other points type dimensions also appear to increment in steps of 0.75. This might be related to my 'typical screen' res, not sure. Regards, Peter T "Darren Hill" wrote in message ... Fantastic! The cells rarely contain more than 500 characters, but can be up to 1000 or so, so I shouldn't hit that problem limit. Can I ask: why does the font size reduce in 0.75 increments? I thought I'd read font size was in 0.5 increments. Thanks, Darren Peter T wrote: 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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adjustable Font Size
Also - delete the indicated line in the Do Loop
FntSize = rTmp.Font.Size ' KEEP this Do If rTmp.Height rCheck.Height Then <<< FntSize = rTmp.Font.Size '''' DELETE this, FntSize = FntSize - 0.25 ' changed from 0.75 rTmp.Font.Size = FntSize rTmp.Columns(1).EntireRow.AutoFit Else Exit Do ' End If Loop Until FntSize < 3 Peter T I have just returned a Font Size of 7.75, not sure now it's such a good idea to increment 0.75. Might be better to change to steps of 0.25. In the Do loop change - FntSize = FntSize - 0.75 to FntSize = FntSize - 0.25 Peter T |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adjustable Font Size
Thanks for the update. I had switched to .25 on my own, and I'll delete
that line now, too. Darren Peter T wrote: Also - delete the indicated line in the Do Loop FntSize = rTmp.Font.Size ' KEEP this Do If rTmp.Height rCheck.Height Then <<< FntSize = rTmp.Font.Size '''' DELETE this, FntSize = FntSize - 0.25 ' changed from 0.75 rTmp.Font.Size = FntSize rTmp.Columns(1).EntireRow.AutoFit Else Exit Do ' End If Loop Until FntSize < 3 Peter T I have just returned a Font Size of 7.75, not sure now it's such a good idea to increment 0.75. Might be better to change to steps of 0.25. In the Do loop change - FntSize = FntSize - 0.75 to FntSize = FntSize - 0.25 Peter T |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Can chart size be dynamically adjustable to fit data points? | Charts and Charting in Excel | |||
Changing Font color based on font type or size | Excel Discussion (Misc queries) | |||
Change all text one font size up with various font sizes used. | New Users to Excel | |||
My tabs' font size is smaller - how do I restore default size? | Excel Discussion (Misc queries) | |||
Dropdown list for font size, font type and number formats | Excel Programming |