ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Find out, if test doesn't fit in a cell (https://www.excelbanter.com/excel-programming/440320-find-out-if-test-doesnt-fit-cell.html)

Christian Treffler

Find out, if test doesn't fit in a cell
 
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

Mike H

Find out, if test doesn't fit in a cell
 
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
.


Gary''s Student

Find out, if test doesn't fit in a cell
 
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
.


Wouter HM

Find out, if test doesn't fit in a cell
 
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

Gary''s Student

Find out, if test doesn't fit in a cell
 
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
.


Christian Treffler

Find out, if test doesn't fit in a cell
 
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

Christian Treffler

Find out, if test doesn't fit in a cell
 
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


All times are GMT +1. The time now is 10:01 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com