Add Text to Shape
It is just a range of cells, like A1:B4 below:
Col A Col B
Row 1 Code Name
Row 2 T2 Smith and Jones
Row 3 T4 Wilson
Row 4 T5 Johnson and Team
Tried the code below, but no luck. What is happening is that data is
downloaded from a database each time the user uses the form, and this data
populates the range above with a code and name. So I need the shape to be
dynamic and always reference what is in that range. Am calling the shape
each time the user selects a cell in a specific column of another tab, via
Worksheet_SelectionChange.
"Dave Peterson" wrote:
Maybe...
Option Explicit
Sub testme()
Dim shp As Shape
Dim sText As String
Dim sLine As String
Dim mySubStr As String
Dim myCell As Range
Dim myRng As Range
Dim myRow As Range
Dim iCtr As Long
With ActiveSheet
Set shp = .Shapes("Rectangle 1")
Set myRng = .Range("s10:u45")
sText = ""
For Each myRow In myRng.Rows
sLine = ""
For Each myCell In myRow.Cells
sLine = sLine & " " & myCell.Text
Next myCell
sText = sText & Mid(sLine, 2) & vbLf
Next myRow
iCtr = 1
Do While iCtr < Len(sText)
mySubStr = Mid(sText, iCtr, 250)
shp.TextFrame.Characters(iCtr).Insert String:=mySubStr
iCtr = iCtr + 250
Loop
End With
End Sub
Dave Peterson wrote:
What's a table?
Is it a picture of that range or what?
Paige wrote:
Sorry I didn't explain myself well enough here. Am actually trying to insert
a small table into the shape; the table spans 3 columns and 5 rows.
"Dave Peterson" wrote:
I'm not sure if the problem you're having is the concatenation of those values
or if the string is too long when you try to plop it into the rectangle.
But this may give you an idea:
Option Explicit
Sub testme()
Dim shp As Shape
Dim sText As String
Dim mySubStr As String
Dim myCell As Range
Dim myRng As Range
Dim iCtr As Long
With ActiveSheet
Set shp = .Shapes("Rectangle 1")
Set myRng = .Range("s10:u45")
sText = ""
For Each myCell In myRng.Cells
sText = sText & " " & myCell.Text
Next myCell
If Len(sText) 0 Then
sText = Mid(sText, 2)
End If
iCtr = 1
Do While iCtr < Len(sText)
mySubStr = Mid(sText, iCtr, 250)
shp.TextFrame.Characters(iCtr).Insert String:=mySubStr
iCtr = iCtr + 250
Loop
End With
End Sub
Paige wrote:
I have the following code (from Tom Ogilvy) that I'm using to put certain
text into a shape; however, cannot figure out how to modify this to
accommodate a range of cells (like S10:U45) versus just one cell. Tried
using a range name also, but that doesn't work. Can someone help me
understand how to do this please?
Dim shp As Shape
Set shp = ActiveSheet.Shapes("Rectangle 1")
sText = Range("A249").Text
shp.TextFrame.Characters.Text = sText
--
Dave Peterson
--
Dave Peterson
--
Dave Peterson
|