import text to Text box

[Guest]

I would like import text from access to text box (text box from drawing tools)
using the following procedure:


Sub Macro2()
Dim strText As String
Dim I As Long

Range("H7").Select
strText = Rs!cmts 'RS is a recordset from access
I = Len(strText)
Debug.Print I

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 100, _
300, 200).Select
Selection.Characters.Text = strText
Range("H7").Select
End Sub

Remarks if I<=255 the code copy text from access to text box if I>255 the
copy nothing to text box.

Question.

What can I do to copy long text from to Text Box?

Thanks for your suggestions

JCP

 

[Guest]

http://support.microsoft.com/default.aspx?scid=kb;en-us;q213802
XL2000: How to Copy Text to Text Boxes Using the Characters Method

http://support.microsoft.com/default.aspx?scid=kb;en-us;q148815
XL: How to Copy Text to TextBoxes Using the Characters Method

 

[Guest]

Hi Tom.
I run the examples existing in the sites and the problem still exist. I
mean, the code doesn't copy text if it has more than 255 characters.
Less 255 characters it works fine.

Do you have any idea how can I fix this issue?

Thanks

 

[Guest]

For x = 1 To txtBox1.Characters.Count Step 250

' Place the first text box text into a variable called theText.
theText = txtBox1.Characters(start:=x, Length:=250).Text

' Place the value of theText variable into second text box.
txtBox2.Characters(start:=x, Length:=250).Text = theText
Next

always works fine for me. I am not sure why you are unsuccessful in
implementing it. This assums a textbox from the drawing toolbar as you
stated.

 

[Guest]

Here you are my solution, I tested and works fine



Sub CopyTextToTextBox()

Dim txtBox1 As TextBox
Dim strText As String 'All Text
Dim shrtText As String 'text to copy
Dim xl As Long 'Length Total
Dim xt As Long 'length of text to copy
Dim pos As Long 'position

strText = Range("A1").Value
xl = Len(strText)
xt = 255
pos = 1

Set txtBox1 = ActiveSheet.DrawingObjects(1)
Set theRange = ActiveSheet.Range("A1:A10")

While pos < xl
Text255 = Mid(strText, pos, 5)
Debug.Print Text255
txtBox1.Characters(Start:=pos, Length:=5).Text = Text255
pos = pos + 5
Wend

End Sub

Thanks for your suggestions

jcp

 

[Guest]

Hi Tom,
I tested to copy from access to text box into excel and it works fine
However, I have one more question.

If in the text I have a paragraph, when the code copy to text box, shows a
small square.
How can I remove these squares?

Thanks

About the previous code, I didn´t replace 5 by the variable. So, ignore it
Here your are:

Sub CopyTextToTextBox()

Dim txtBox1 As TextBox
Dim strText As String 'All Text
Dim Text255 As String 'text to copy
Dim xl As Long 'Length Total
Dim xt As Long 'length of text to copy
Dim pos As Long 'position

strText = Range("A1").Value
xl = Len(strText)
xt = 255
pos = 1

Set txtBox1 = ActiveSheet.DrawingObjects(1)
Set theRange = ActiveSheet.Range("A1:A10")

While pos < xl
Text255 = Mid(strText, pos, xt)
Debug.Print Text255
txtBox1.Characters(Start:=pos, Length:=5).Text = Text255
pos = pos + xt
Wend

End Sub

 

[Guest]

Something along the lines of:

pos1 = pos
While pos < xl
Text255 = Mid(strText, pos, xt)
Debug.Print Text255
Text255 = Replace(Text255,chr(13),"")
txtBox1.Characters(Start:=pos1, Length:=len(Text255)).Text = Text255
pos1 = pos1 + len(Text255)
pos = pos + xt
Wend

if replacing Chr(13) doesn't work, then try Chr(10), but I think it is
Chr(13) that needs to be removed.

 

[Guest]

Replacing Chr(13) works perfectly in my example.
I'm happy with your help.
Thanks a lot,