Insert Rectangle Shape based on data

[Stefan_Sand]

hello,

I have a list of data, where i have some names and text (for the shapes). - Lets say, there are about 30 - 60 entries - in column b for the name and column c for the text to insert into the shapes ->
What i need to know is, if there is a possibility to insert rctangles for each entry / rename them (out of column b) and get the text from column c into them??

please help,
stefan

[HansV]

It is possible to write a macro for that purpose. How would you like to position the shapes?

[Stefan_Sand]

hi Hans, thanks for your answer,

I would position them right (?) from column e in "descending" order, but i would adopt them manually after the creation.

stfan

[HansV]

Try this as starting point; you'll have to adapt it for your own situation:

Code: Select all

Sub CreateShapes()
  Dim r As Long
  Dim m As Long
  Dim strName As String
  Dim strText As String
  Dim shp As Shape
  m = Cells(1, 2).End(xlDown).Row
  For r = 2 To m
    strName = Cells(r, 2).Value
    strText = Cells(r, 3).Value
    On Error Resume Next
    Set shp = ActiveSheet.Shapes(strName)
    If Err Then
      Set shp = ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, _
        Left:=288, Top:=96 * r, Width:=144, Height:=72)
    End If
    On Error GoTo 0
    shp.Name = strName
    shp.TextFrame.Characters.Text = strText
  Next r
End Sub

Sample workbook attached.

StefanDemo.xls

[Stefan_Sand]

Hans,
thats so pretty cool,
thank You,
stefan