Autosize text box with fixed width

[zzjasonzz]

Hi all,

I have a text box which i want to autosize so the text is all visible inside it but the width has to stay the same.

at the moment I have

            With Selection
                .AutoSize = True
                .Width = 500
            End With

But obviously this doesn't work because it autosizes the height based on a width I can't use, then sets the width back and I have the same problem.

I hope this makes sense and that there is an easy solution!

Regards,

Jason

 

[BrianB]

According to Excel Help, Autosize "should" only affect the height of the textbox. However, it seems that this setting is over-ridden if the textbox is resized manually - even though the property is not changed.

This code seems to work correctly in my setup. It resets Autosize to False and then back to True again, and the texbox reacts appropriately.

There is some commented-out code that you may like to try that resets the height depending on the number of characters. This will oviously be dependant on what size text you are using - so trial and error is needed.

Sub test()
    Dim MyTextBox As Object
    Dim MyTextLength As Integer
    '-----------------------------------------------
    Set MyTextBox = ActiveSheet.TextBox1
    With MyTextBox
        .AutoSize = False   ' remove setting
        .Width = 500
        .MultiLine = True
        .Font.Size = 10
        .AutoSize = True    ' reset autosize
    End With
    '-----------------------------------------------
    '- set height according to number of characters
'    MyTextLength = Len(MyTextBox.Text)
'    MyTextBox.Height = MyTextLength / 7
End Sub

 

[zzjasonzz]

Awesome I'll try it out on monday (YAY WEEKEND!) I was just about to bump this for the night time crowd (night for me)

Thanks

(might be the .MultiLine = True)

 

[zzjasonzz]

Hi,

Can anyone help with this problem?

I tried using .multiline = true but it says "object doesn't support this property or method"

is it because of my version of excel, how do i check? is there another way to solve this problem?

Thanks!


EDIT: I read that you need vbscript 5.5 or greater to run this and i am running 5.6 ... any ideas?

 

[zzjasonzz]

Obviously I'm missing some fundemental knowledge on text boxes so anyone want to fill me in?
I've tried the following things (*** is where the error occurs)

        Dim MyTextBox As Object
        
        Set MyTextBox = ActiveSheet.BC_Comments ***
        With MyTextBox
            .AutoSize = False
            .Width = bc_dwidth
            .MultiLine = True
            .AutoSize = True
        End With

and

        ActiveSheet.Shapes("BC_comments").Select
       Dim MyTextBox As Object
        
        Set MyTextBox = selection
        With MyTextBox
            .AutoSize = False
            .Width = bc_dwidth
            .MultiLine = True ***
            .AutoSize = True
        End With

        Dim MyTextBox As Object
        
        Set MyTextBox = ActiveSheet.Shapes("BC_Comments") 
        With MyTextBox
            .AutoSize = False ***
            .Width = bc_dwidth
            .MultiLine = True
            .AutoSize = True
        End With

note that the object IS a text box when i right click on it it says "Format text box"

</newbie>

 

[BrianB]

Sorry it took so long to reply. Not only have I had some time off, but I have had to do some work too.

There are 3 kinds of textbox - Drawing Toolbar/Worksheet Control/Userform. We have discovered you are using the Drawing one. This one is automatically multiline, and does not have this as a property - hence the error message.

The macro below will probably need a bit of tweaking because we have to calculate the number of lines taken by the text using the font character height and width. A bit of trial and error to discover - bearing in mind that even in the same font the character width differs.

'=======================================================
'- CHANGE LENGTH OF DRAWING TOOLBAR TEXTBOX
'- checks text length & number of chr(10) line breaks
'- very rough - adjust font width/height as required
'=======================================================

Sub CheckLength()
    Dim TB As Object
    Dim BoxText As String
    Dim BoxWidth As Double
    Dim FontSize As Integer
    Dim CharWidth As Double     ' estimated width of each character
    Dim CharHeight As Double    ' estimated height of each character
    Dim CharPerLine As Integer  ' characters per line
    Dim LineCount As Integer
    Dim TextLength As Integer
    Dim EOLCount As Integer
    Dim EOL As String           ' line break character 10
    '------------------------------------------------------------
    ActiveSheet.Range("A1").Select ' remove focus from text box
    EOL = Chr(10)                  ' end of line character
    Set TB = ActiveSheet.Shapes("BC_Comments")
    BoxWidth = TB.Width
    '------------------------------------------------------------
    '- GET TEXTBOX CONTENTS INFORMATION
    With TB.TextFrame
        BoxText = .Characters.Text
        FontSize = .Characters.Font.Size
        TextLength = .Characters.Count
        If TextLength = 0 Then
            MsgBox ("Empty box")
            Exit Sub
        End If
        '----------------------------------------------------------
        '- count EOL characters
        EOLCount = 0
        For c = 1 To Len(BoxText)
            If Mid(BoxText, c, 1) = EOL Then
                LineCount = LineCount + 1
            End If
        Next
    End With
    '--------------------------------------------------------------
    '- CALCULATIONS
    Select Case FontSize
        Case Is = 8
            CharWidth = 4.65
            CharHeight = 12.77
        Case Is = 10
            CharWidth = 5.55
            CharHeight = 14
        Case Is = 12
            CharWidth = 5.55
            CharHeight = 16.4
        Case Else
            MsgBox ("Font size " & FontSize & " not valid")
            Exit Sub
    End Select
    '----------------------------------------------
    CharPerLine = BoxWidth / CharWidth
    LineCount = TextLength / CharPerLine + EOLCount + 1
    TB.Height = LineCount * CharHeight
    '------------------------------------------------------------
    '- testing
'    MsgBox ("Box Width : " & BoxWidth & vbCr _
'        & "Characters  : " & TextLength & vbCr _
'        & "FontSize    : " & FontSize & vbCr _
'        & "LineHeight  : " & CharHeight & vbCr _
'        & "Per Line    : " & CharPerLine & vbCr _
'        & "Lines       : " & LineCount & vbCr _
'        & "Height      : " & LineCount * CharHeight)
End Sub