PDA

View Full Version : How to creat Dynamic Text box in term of size



yurble_vn
07-27-2007, 09:58 AM
I'm intending to make dynamics text box.I means that the textbox height will be changed according to the textcontent. But my facing trouble is:

1. How to catch-up the text box edit event.
2. How to change the the textbox height according to the text content.

Please, anybody had done that before, please help

malik641
07-27-2007, 04:12 PM
Hi yurble_vn :hi: Welcome to VBAX

I haven't done this before, but it's very interesting so I thought I'd give it a shot. After some testing I found that the following code is pretty decent. There is some flickering, but I tried to keep that to a mininum. The flickering is due to the Repaint method, but this is necessary because I was getting weird results when I wasn't using it (the text was displayed all weird). FYI be sure to set the textbox height to 15.75 in design mode, and set the textbox's properties: EnterKeyBehavior=TRUE & MultiLine=TRUE.
And obviously, make sure to have some sort of 'height limit' for this, you never know if your user will press enter too many times. I set it to 5 lines, you can set it to whatever you like.

Here is the code:
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If TextBox1.LineCount < 5 Then ' This is the limit for expanding the textbox
If KeyCode = 13 Then ' 13 is the Enter key
' 9.75 is standard height to view new lines for Arial font
TextBox1.Height = TextBox1.Height + 9.75
Me.Repaint
Else
If TextBox1.LineCount <> 0 Then
' 9.75 is standard height to view new lines for Arial Font
TextBox1.Height = 15.75 + ((TextBox1.LineCount - 1) * 9.75)
Me.Repaint
End If
End If

End If

Debug.Print KeyCode ' Just to check which key has been pressed. This helped
' me to figure out when DELETE, BACKSPACE, and ENTER was pressed
End Sub

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim iCurLine As Long, iSelStart As Long
iSelStart = TextBox1.SelStart

If TextBox1.LineCount < 5 Then ' This is the limit for expanding the textbox
' KeyCode 8 is BACKSPACE and KeyCode 46 is DELETE
If TextBox1.LineCount <> 0 And (KeyCode = 8 Or KeyCode = 46) Then
TextBox1.Height = 15.75 + ((TextBox1.LineCount - 1) * 9.75)
Me.Repaint
End If
End If

' If the user selects text using SHIFT
If TextBox1.SelLength = 0 Then
' This is used so the user sees the text shift
' back downward as they DELETE back and moving UPWARD
TextBox1.SelStart = 0
TextBox1.SelStart = iSelStart
End If
End Sub
Not bad if I do say so myself :whistle:

Good luck!

malik641
07-27-2007, 04:47 PM
I just realised that this doesn't work for Drag and Drop or Paste, so I updated it for that :)

BTW, I can't get it to work right when a user would Cut all text (or enough to satisfy a condition to change the size of the textbox).
EDIT: Nevermind, I got it to work. I changed the _KeyUp event a little :thumb

EDIT_2: Also changed to handle UP, DOWN, LEFT, RIGHT keys (it wasn't acting correctly)
Option Explicit
Private blnDropOrPaste As Boolean

Private Sub TextBox1_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, _
ByVal Action As MSForms.fmAction, _
ByVal Data As MSForms.DataObject, _
ByVal X As Single, _
ByVal Y As Single, _
ByVal Effect As MSForms.ReturnEffect, _
ByVal Shift As Integer)
blnDropOrPaste = True
End Sub

Private Sub TextBox1_Change()
If blnDropOrPaste = True Then
If TextBox1.LineCount < 5 Then ' This is the limit for expanding the textbox
If TextBox1.LineCount <> 0 Then
' 9.75 is standard height to view new lines for Arial Font
TextBox1.Height = 15.75 + ((TextBox1.LineCount - 1) * 9.75)
Me.Repaint
End If
Else
' Set textbox Height for 5 lines
If TextBox1.Height <> 15.75 + (4 * 9.75) Then TextBox1.Height = 15.75 + (4 * 9.75)
End If

blnDropOrPaste = False
End If
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
' Don't execute code for LEFT, UP, RIGHT, DOWN keys
Select Case KeyCode
Case 37, 38, 39, 40
Exit Sub
End Select

If TextBox1.LineCount < 5 Then ' This is the limit for expanding the textbox
If KeyCode = 13 Then ' 13 is the Enter key
' 9.75 is standard height to view new lines for Arial font
TextBox1.Height = TextBox1.Height + 9.75
Me.Repaint
Else
If TextBox1.LineCount <> 0 Then
' 9.75 is standard height to view new lines for Arial Font
TextBox1.Height = 15.75 + ((TextBox1.LineCount - 1) * 9.75)
Me.Repaint
End If
End If
Else
' Set textbox Height for 5 lines
If TextBox1.Height <> 15.75 + (4 * 9.75) Then TextBox1.Height = 15.75 + (4 * 9.75)
End If

Debug.Print KeyCode ' Just to check which key has been pressed. This helped
' me to figure out when DELETE, BACKSPACE, and ENTER was pressed
End Sub

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
' Don't execute code for LEFT, UP, RIGHT, DOWN keys
Select Case KeyCode
Case 37, 38, 39, 40
Exit Sub
End Select

Dim iCurLine As Long, iSelStart As Long
iSelStart = TextBox1.SelStart

If TextBox1.LineCount < 5 Then ' This is the limit for expanding the textbox
' KeyCode 8 is BACKSPACE and KeyCode 46 is DELETE
If TextBox1.LineCount <> 0 And (KeyCode = 8 Or KeyCode = 46) Then
TextBox1.Height = 15.75 + ((TextBox1.LineCount - 1) * 9.75)
Me.Repaint
ElseIf TextBox1.LineCount <= 1 Then
TextBox1.Height = 15.75
End If
Else
' Set textbox Height for 5 lines
If TextBox1.Height <> 15.75 + (4 * 9.75) Then TextBox1.Height = 15.75 + (4 * 9.75)
End If

' If the user selects text using SHIFT
If TextBox1.SelLength = 0 Then
' This is used so the user sees the text shift
' back downward as they DELETE back and moving UPWARD
TextBox1.SelStart = 0
TextBox1.SelStart = iSelStart
End If
End Sub

It's not perfect, but hey, I tried :)

yurble_vn
08-09-2007, 09:33 AM
I have worked on this last week, but, actualy, I'm newbie in excel vba. So I really dont know how to put the code in applying.

WHen copy the above code to excel text box code, and enter, it return error on Me.Repaint

Please give more explain. THanks

malik641
08-09-2007, 06:38 PM
I'm attaching an example workbook that does not have the error you speak of. I'm not sure how you would get that error to tell you the truth.

The idea of this code is to keep track of how many lines there are in the text box (and you have to make sure the text box's multiline property is true and the wordwrap property is true beforehand). This is done by using "TextBox1.LineCount". Once LineCount increments, so does the text box (until 5 lines, a limit that I placed on the expansion of the text box). After some testing I noticed that the LineCount property does not increment itself when you hit Enter because there is no text in the new line. So to correct this I trapped the ENTER Ascii keycode (code 13) in the _KeyUp & _KeyDown events (which the value is passed to the procedure to the KeyCode variable).

Why do I use both _KeyUp and _KeyDown? If there was no _KeyUp event, for example, and there are 5 lines of text and the text box is expanded as it should be, then if the user selects all the text (CTRL+A) and presses DELETE then the text box will not shrink back to 1 line as it's supposed to until the user enters one character of text. _KeyUp is also used to shift the text 'downward' as the user deletes using BACKSPACE or SHIFT-selecting text and pressing DELETE. Rather than seeing blank space below the curson, the 'view' of the text is pushed downward (this is in the case of many lines of text).
Now for the _KeyDown event, that is necessary too because it keeps exanding the text box as a user holds down a key and lets it continue to fill the text box. What happens is for every character that shows up from holding down a key on the keyboard, the _KeyDown event is 'fired'. So when the characters exceed the length of the current line, the WordWrap property sees this and increments the LineCount by 1. This also activates the _KeyDown event (because there is yet another character entered into the text box), and so the code sees this increment in LineCount and therefore expands the text box further (so long as it didn't pass the limit of 5 that I had placed, in that case, no action is taken).

After more testing I noticed that if you Copy-Paste text (using the mouse) into the text box (or Drag-And-Drop text) the text box doesn't expand. This is because the _KeyUp and _KeyDown events are not activated (since nothing on the keyboard was pressed). So I added the _BeforeDropOrPaste event to change a boolean variable to TRUE if this event was activated. After this event is activated the _Change event is activated (with the new text pasted in the text box). The _Change event checks the boolean variable to see if it's TRUE, and if it is then it expands the text box as necessary. The reason I cannot just use the _BeforeDropOrPaste event for this is because this event occurs before the text is added to the text box. So I used the _Change event since it has the text in it and is activated directly after the _BeforeDropOrPaste event (you can kind of think of the _Change event like a _AfterDropOrPaste event...even though there is no such event for the text box).


And that's basically the code. I don't think I can be more descriptive than that (in one sitting) :) I hope it helps your learning of VBA.

malik641
08-09-2007, 06:52 PM
Sorry, forgot to add the workbook.

Here you go.

yurble_vn
08-10-2007, 04:32 AM
Get your point.
and also found my wrong. I applied it to textbox in excel, not in userform.

Is there any way to do this, but in excel design text box ?

malik641
08-10-2007, 05:04 AM
I'll have to see tonight/tomorrow, but if I'm not mistaken I believe all you have to do is place the text box on Sheet1 (for example), then place all the code in the Sheet1 module. And you should change Me.Repaint to (I guess) TextBox1.Repaint. If this gives you an error, or if the Repaint method doesn't exist, then comment it out and see what happens...otherwise I would just check to see if all the events exist for a text box object in a sheet.

I'm not 100% sure, but that's how I'd approach it if I was not at work and I could work on it.

rory
08-10-2007, 05:25 AM
If you've used the textbox from the Drawing toolbar on a worksheet, right-click it, choose Format Control, switch to the Alignment tab and check the Automatic Size option.