ms excel vba : is there a way to programticly determine if wrapped text in a cell is entirely visible or not?

I am trying to cram as much text into small cells as possible ms. is there a way to programticly determine if wrapped text in a cell is entirely visible or not? if there was I could just keep checking and lowering the font size by a point until it fits. shrink to fit only works on unwrapped lines
Dov_BAsked:
Who is Participating?
 
AgneauConnect With a Mentor Commented:
Hello Dov_B,

Unfortunately what your are asking for is not possible. Excel does not implement any property to evaluate if the cell's content is visible or not.

"Wrap text" and "Shrink to fit" are opposite concepts, that is why Excel disable the "Shrink to fit" option when you mark a cell with the "Wrap text" option.

Of course you can create some VBA code to mimic the shrinking feature in a wrapped cell, however such code won't be bullet proof.

Anyway you have down here a sample that implements what you want... but again, it's not bullet proof.

Sub ShrinkWrappedCell()
    Dim oldRowHeight As Double
    Dim oldFontSize As Double
    Dim newFontSize As Double
    
    oldRowHeight = ActiveCell.RowHeight
    oldFontSize = ActiveCell.Font.Size
    newFontSize = oldFontSize
    
    ActiveCell.Rows.AutoFit
    
    While ActiveCell.RowHeight > oldRowHeight
        newFontSize = newFontSize - 0.5
        ActiveCell.Font.Size = newFontSize
        ActiveCell.RowHeight = oldRowHeight
        ActiveCell.Rows.AutoFit
    Wend
        
End Sub

Open in new window


Regards
0
 
gowflowCommented:

is there a way to programticly determine if wrapped text in a cell is entirely visible or not?

What do you mean by that it is not clear

gowflow
0
 
Dov_BAuthor Commented:
wow That is very clever coding! Genius!
well I fooled aaround with it a bit
Sub ShrinkWrappedCell()
    'Application.ScreenUpdating = False
    Dim oldRowHeight As Double
    Dim oldFontSize As Double
    Dim newFontSize As Double
    Dim resizeCell As Range
    Cells(1, 1).EntireRow.Insert
    ActiveCell.Offset(1).Select
    Set resizeCell = Cells(1, 1)
    
    resizeCell.WrapText = True
    resizeCell.RowHeight = ActiveCell.RowHeight
    oldRowHeight = ActiveCell.RowHeight
    oldFontSize = ActiveCell.Font.Size
    resizeCell.Font.Size = ActiveCell.Font.Size
    resizeCell.Font.Name = ActiveCell.Font.Name
    resizeCell.HorizontalAlignment = ActiveCell.HorizontalAlignment
    resizeCell.VerticalAlignment = ActiveCell.VerticalAlignment
    resizeCell = ActiveCell.Text
    newFontSize = oldFontSize
    
    resizeCell.Rows.AutoFit
    
    While resizeCell.RowHeight > oldRowHeight
        newFontSize = newFontSize - 0.5
        resizeCell.Font.Size = newFontSize
        resizeCell.RowHeight = oldRowHeight
        resizeCell.Rows.AutoFit
    Wend
    Dim k As Range
    Set k = ActiveCell
        ActiveCell.Font.Size = newFontSize
        'ActiveCell.RowHeight = oldRowHeight
'        ActiveCell.Rows.AutoFit
        Cells(1, 1).EntireRow.Delete
        
        Application.ScreenUpdating = False
        k.Select

Open in new window

my question is why aint it bullet proof
sometimes the resizeCell.Rows.AutoFit just doesnt autofit !! It resizes the row leaving part of the text cut off?!! any help is much appreciated.
0
 
AgneauCommented:
Hello Dov_B,

The problem is that in some particular cases the routine may shrink the font up to 1, when the text is really big.
Nothing to worry but sometimes annoying.

Regards
0
 
Dov_BAuthor Commented:
I did notice that once I think that I fixed that (not sure),
did you notice that it does notalways autosize the row correctly and can sometimes leave the text to large
by the way in a different programing language I use there is a function called calcTextRec which figures out the dimensions of a string is there anything like that in vba? I did find something for width but not height
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.