TextBox con AutoShrink

[joelcg]

Necesito el codigo para hacer que un textBox permita que el texto que se escribe en el se pueda reducir para que quepa dentro de si. Es algo como un autoshink con wraptext en una celda pero lo necesito para un userform.

 

[Greg Truby]

Primeramente, usted puede hacer View | Properties para ver las propiedades del Textbox control y poner WrapText a True (si uno hace esto también hay que cambiar MultiLine a True).

Si esto no es posible entonces usted puede aprovechar el Change Event Handler del Textbox control para ajustar el tamaño del Font.

<font face=Courier New>
<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> TextBox1_Change()
    <SPAN style="color:#00007F">Dim</SPAN> intFontSize <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>
    <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> Len(Me.TextBox1.Text)
        <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> < 50: intFontSize = 12
        <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> < 70: intFontSize = 11
        <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> < 100: intFontSize = 10
        <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> < 120: intFontSize = 9
        <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> < 150: intFontSize = 8
        <SPAN style="color:#00007F">Case</SPAN> Else: intFontSize = 7
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
    Me.TextBox1.Font.Size = intFontSize
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>

Saludos,

 

[joelcg]

Re: Gracias GREG

HOLA amigo Greg:
ray:
FUNCIONOOOOO lo que me distes y te estoy muy agradecido. Lo he adaptado a mi caso particular y aquí te paso mis especificaciones porque me funcionaron a la perfección.

El textbox mide HEIGHT = 78 WIDHT = 654 y el código que me distes lo adapté así:

Private Sub TextBox2_Change()
Dim intFontSize As Integer
Select Case Len(Me.TextBox2.Text)
Case Is < 25: intFontSize = 48
Case Is < 26: intFontSize = 47
Case Is < 27: intFontSize = 46
Case Is < 28: intFontSize = 44
Case Is < 29: intFontSize = 43
Case Is < 32: intFontSize = 40
Case Is < 33: intFontSize = 38
Case Is < 34: intFontSize = 35
Case Is < 36: intFontSize = 34
Case Is < 37: intFontSize = 33
Case Is < 38: intFontSize = 31
Case Is < 39: intFontSize = 30
Case Is < 41: intFontSize = 29
Case Is < 43: intFontSize = 27
Case Is < 44: intFontSize = 25.5
Case Is < 47: intFontSize = 25
Case Is < 53: intFontSize = 24.5
Case Is < 113: intFontSize = 22
Case Is < 123: intFontSize = 19
Case Is < 131: intFontSize = 18
Case Is < 143: intFontSize = 16
Case Is < 500: intFontSize = 15
End Select
Me.TextBox2.Font.Size = intFontSize
End Sub

ES UNA MARAVILLAAAAA como funciona como un autoshrink.

También me las arreglé para reducir el tamaño de este código usando formulas en combinación con la macro y es así:

En C6 escribo lo que se reflejará en el textbox2

En G6 escribo la formula =LEN(C6) para que me de la cantidad de caracteres en la celda.

En H6 escribo la formula =VLOOKUP(G6,valdea,2,) para que me busque esa cantidad que refleja la celda en una base de datos llamada valdea en la columna 2 tengo los valores que ves en la macro que modifiqué arriba.

Ahora abro un evento initialize para el userform que alberga el textbox y escribo la siguiente macro que resume la que me distes larga pero que hacen lo mismo:

Sub UserForm_Initialize()

Dim b as integer

Set b = 6

If Len(Me.TextBox2.Text) = Cells(b, 7).Value Then ‘compara largos de caracteres G6
intFontSize = Cells(b, 8).Value ‘ tamaño del texto en H6
Me.TextBox2.Font.Size = intFontSize ‘ tamaño del texto del textbox
End If

End Sub

Y esto me ahorra espacio y como esa variable b se incrementa por 6 cada vez que abro el userform (b = b + 6), entonces me valgo de tan solo UN userform para desplegar cientos de miles de valores que tengo en las celdas y eso me sirvió para ahorrar espacio en disco duro y eficiencia en memoria RAM.

He aprendido mucho estos días leyendo lo que escriben aquí y les estoy MUY AGRADECIDO que DIOS los bendiga y gracias.

PD: me compré el libro VBA and Macros de Bill Jelen para aprender más.