Resize font to fit text box

[tunsarod]

I am designing a report to print labels to a specific layout format. I need a way to detect when the text in any given text box exceeds the available space in the text box (over fills its text box) so that the font size can be reduced programatically to allow the text to fit neatly within the text box, rather than resize the box to fit the text.

Any ideas???

 

[ZmrAbdulla]

Hi,
Here is the sample.

http://www.lebans.com/makefitsingle.htm

Regards

Zameer Abdulla

http://www.geocities.com/zameerabd/

http://www.mtkhoory.com

 

[tunsarod]

Zameer, Thanks for the update, an useful site.

After posting my query I did manage to create my own solution but thanks anyway.

For anyone who is interested, if the code below is placed in the On Print event of a report's Detail section then any text boxes with names that begin with "v" will have the font resized to ensure the entire text fits the available space. The "v" bit is just my way of making it possible to resize the text in some text box controls and not others.

Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)
Dim ctl As Control, strText As Variant, strName As String
' This routine uses the TextWidth methods to determine the maximum size
' of font possible to ensure a text string is printed in full in the
' report's current font without loosing any characters.
    
    Me.ScaleMode = 1 ' set all measurments to twips
    
    For Each ctl In Me.Detail.Controls
   
        If ctl.ControlType = acTextBox And ctl.Name Like "v*" Then
        
        strName = ctl.Name
        
            If Nz(ctl.Tag, "") = "" Then
                ctl.Tag = ctl.FontSize
            End If
            
                
        ' set the control's fontsize to a suitable large size to begin with
            ctl.FontSize = ctl.Tag

        ' make sure the report font size is equal to the control's fontsize.
            Me.FontSize = ctl.FontSize
        
        ' grab the text from the control
            strText = ctl.Value 
        
        ' evaluate the Loop until the text fits the Width of the box less 24%. Do this
        ' by reducing the font size incrementally and re-testing the Loop's criteria.
            Do Until TextWidth(strText) < ctl.Width '- (ctl.Width * 0.26)
                ctl.FontSize = ctl.FontSize - 1
                ' reset the report's font size so the TextWidth function will
                ' continue to track the reducing font size correctly.
                Me.FontSize = ctl.FontSize
            Loop
            
        ' now evaluate for the height of the text to make sure it fits vertically
            Do Until TextHeight(strText) < ctl.Height - (ctl.Height * 0.26)
                ctl.FontSize = ctl.FontSize - 1
                ' reset the report's font size so the TextHeight function will
                ' continue to track the reducing font size correctly.
                Me.FontSize = ctl.FontSize
            Loop
        
        End If
        
    Next ctl
    
End Sub