Hi,

I'm automatically inserting text in Excel cells. The cells height and
width is fixed and shouldn't be changed.

I'd like to automatically reduce font size, if a text doesn't fit.
I would use conditional formatting, but I guess that there's no Excel
function available that would help here. And for some reason the font
size can not be changed by conditional formatting on my system.

So I'd like to use VBA, but how?
The easiest way would be to determine, how much space a text needs and
compare it with the cell width. But how do I get the first parameter?

Another idea would be to set a cell to automatic word wrap. All I need
then is to get the current number of lines. If it's greater then one, I
would reduce the font size. But how to I get the number of lines from an
automaticalley wrapped text?

TIA,
Christian

Hi,

This is a bit of a scattergun approach. It loops though each cell of the
used range testing the text width by autofitting the column width and
reducing font size until the column is back to the original width

Sub Fit_Columns()
Dim c As Range
For Each c In ActiveSheet.UsedRange
If Len(c.Value) 0 Then
oldwidth = c.ColumnWidth
Do
c.EntireColumn.AutoFit
If c.ColumnWidth oldwidth Then
c.Font.Size = c.Font.Size - 1
c.EntireColumn.AutoFit
Else
c.ColumnWidth = oldwidth
End If
Loop Until c.ColumnWidth <= oldwidth
If c.ColumnWidth < oldwidth Then
c.ColumnWidth = oldwidth
End If
End If
Next
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Christian Treffler" wrote:

Hi,

I'm automatically inserting text in Excel cells. The cells height and
width is fixed and shouldn't be changed.

I'd like to automatically reduce font size, if a text doesn't fit.
I would use conditional formatting, but I guess that there's no Excel
function available that would help here. And for some reason the font
size can not be changed by conditional formatting on my system.

So I'd like to use VBA, but how?
The easiest way would be to determine, how much space a text needs and
compare it with the cell width. But how do I get the first parameter?

Another idea would be to set a cell to automatic word wrap. All I need
then is to get the current number of lines. If it's greater then one, I
would reduce the font size. But how to I get the number of lines from an
automaticalley wrapped text?

TIA,
Christian
.

Begin by recording the row height
then insert the text in a cell and turn on autofit
then compare the new row height to the original

If the height increased, you must reduce font size:

Sub FixHite()
Dim B1 As Range
Set B1 = Range("B1")
B1.Clear
MsgBox B1.EntireRow.Height
B1.Value = "Now is the time for all good men"
B1.WrapText = True
MsgBox B1.EntireRow.Height
End Sub

--
Gary''s Student - gsnu201001


"Christian Treffler" wrote:

Hi,

I'm automatically inserting text in Excel cells. The cells height and
width is fixed and shouldn't be changed.

I'd like to automatically reduce font size, if a text doesn't fit.
I would use conditional formatting, but I guess that there's no Excel
function available that would help here. And for some reason the font
size can not be changed by conditional formatting on my system.

So I'd like to use VBA, but how?
The easiest way would be to determine, how much space a text needs and
compare it with the cell width. But how do I get the first parameter?

Another idea would be to set a cell to automatic word wrap. All I need
then is to get the current number of lines. If it's greater then one, I
would reduce the font size. But how to I get the number of lines from an
automaticalley wrapped text?

TIA,
Christian
.

Hi,

I think you would like it to change the font directly after you enter
a value.
So I used the Worksheet-Change event, which should be added to the
codepage of the worksheet.



Private Sub Worksheet_Change(ByVal Target As Range)

Dim aWith As Double

aWith = Target.ColumnWidth
Application.ScreenUpdating = False
Target.EntireColumn.AutoFit
Do While Target.ColumnWidth aWith
Target.Font.Size = Target.Font.Size - 1
Target.EntireColumn.AutoFit
Loop
If Target.EntireColumn.Width < aWith Then
Target.ColumnWidth = aWith
End If
Application.ScreenUpdating = True
End Sub


HTH,

Wouter

intresting idea
--
Gary''s Student - gsnu201001


"Wouter HM" wrote:

Hi,

I think you would like it to change the font directly after you enter
a value.
So I used the Worksheet-Change event, which should be added to the
codepage of the worksheet.



Private Sub Worksheet_Change(ByVal Target As Range)

Dim aWith As Double

aWith = Target.ColumnWidth
Application.ScreenUpdating = False
Target.EntireColumn.AutoFit
Do While Target.ColumnWidth aWith
Target.Font.Size = Target.Font.Size - 1
Target.EntireColumn.AutoFit
Loop
If Target.EntireColumn.Width < aWith Then
Target.ColumnWidth = aWith
End If
Application.ScreenUpdating = True
End Sub


HTH,

Wouter
.

Wouter HM schrieb:

So I used the Worksheet-Change event, which should be added to the
codepage of the worksheet.

That was my plan, yes.

CU,
Christian

Gary''s Student schrieb:

Begin by recording the row height
then insert the text in a cell and turn on autofit
then compare the new row height to the original

Ah, the "Try it and check what happens" method. I have rather hoped that
there is a method or property which gives me the information directly.
But you cannot have everything, obviously.

Thank you and Mike for that tip.

CU,
Christian