Change font size dynamically in a textbox (not userform textbox)

[ajoy123rocks]

I require a textbox to change the font size of text dynamically based on number of characters in the text

Initially the size is 14
if no. of characters < 20 size = 14
if no. of characters > 20 and < 25, size =13
if no. of characters > 24 and < 30 size = 12

 

[John_w]

ActiveX text box named TextBox1, code in the sheet module:

Private Sub TextBox1_Change()
    Select Case Len(TextBox1.Value)
        Case 1 To 19
            TextBox1.Font.Size = 14
        Case 20 To 24
            TextBox1.Font.Size = 13
        Case 25 To 29
            TextBox1.Font.Size = 12
    End Select        
End Sub

 

[ajoy123rocks]

ActiveX text box named TextBox1, code in the sheet module:

Private Sub TextBox1_Change()
    Select Case Len(TextBox1.Value)
        Case 1 To 19
            TextBox1.Font.Size = 14
        Case 20 To 24
            TextBox1.Font.Size = 13
        Case 25 To 29
            TextBox1.Font.Size = 12
    End Select       
End Sub

I dont want to use to activeX textbox (as mentioned in the title)..... just normal textbox

 

[John_w]

Sorry. For a shape text box:

Public Sub Update_Text_Box_Font_Size(tb As Shape)
    Select Case Len(tb.TextFrame.Characters.Text)
        Case 1 To 19
            tb.TextFrame.Characters.Font.Size = 14
        Case 20 To 24
            tb.TextFrame.Characters.Font.Size = 13
        Case 25 To 29
            tb.TextFrame.Characters.Font.Size = 12
    End Select
End Sub

To change the font size dynamically you would have to call the above from a Worksheet event, for example:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Update_Text_Box_Font_Size Me.Shapes("TextBox 1")
End Sub