VBA change formula in shapes

[FredMcStaire]

I have the following code that loops through a list and for each item in the list creates a shape with the text equal to the list item. . It works fine, but need some help to augment by changing two things:
1) instead of just putting the text in as a static item, how do i put in a formula ?
2) the active region is causing a few issues: the cursor needs to be at the start of the list, and "currentregion" picks up cells around the list.
Thanks!

Sub ListToShapesWithText()
' to create as many shapes as there are rows in a list and then populate the shapes with the text in the cells

Dim NumberOfRows As Long
Dim CurrentName As String
Dim PositionX As Integer    ' to offset a bit on the x axis
Dim PositionY As Integer    ' to offset a bit on the y axis

NumberOfRows = Selection.CurrentRegion.Rows.Count

        For i = 1 To NumberOfRows ' to start the loop

            'to find the current name
            CurrentName = ActiveCell.Value
          
            'to set the  placement of the shape
            PositionX = 500 + (i * 10)
            PositionY = 200 + (i * 10)
          
            'to add the shape in a certain spot, all slightly offset
            ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, PositionX, PositionY, 100, 30).Select
                  
            'to style the shape
            Selection.ShapeRange.ShapeStyle = msoShapeStylePreset6
                
            'to name the current shape
            Selection.Name = CurrentName
          
         'to put text into the shape
           ActiveSheet.Shapes(CurrentName).TextFrame.Characters.Text = CurrentName
                                
            'to move the selection down one
            ActiveCell.Offset(1, 0).Select
  
        Next i
  
End Sub

 

[Domenic]

Your code can be re-written to avoid using Selection, and to add a formula to a shape, as follows . . .

            'to add the shape in a certain spot, all slightly offset
            Dim shp As Shape
            Set shp = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, PositionX, PositionY, 100, 30)
           
            With shp
                 
                'to style the shape
                .ShapeStyle = msoShapeStylePreset6
               
                'to name the current shape
                .Name = CurrentName
               
                'add formula to the shape (change accordingly)
                .DrawingObject.Formula = "=B2"
             
            End With

Hope this helps!

 

[FredMcStaire]

Your code can be re-written to avoid using Selection, and to add a formula to a shape, as follows . . .

            'to add the shape in a certain spot, all slightly offset
            Dim shp As Shape
            Set shp = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, PositionX, PositionY, 100, 30)
          
            With shp
                
                'to style the shape
                .ShapeStyle = msoShapeStylePreset6
              
                'to name the current shape
                .Name = CurrentName
              
                'add formula to the shape (change accordingly)
                .DrawingObject.Formula = "=B2"
            
            End With

Hope this helps!

Thanks Domenic - this does help and answers most of what I needed, but maybe didn't say: The end result of the formula would be a different formula in each shape, referring to the cell, so that

• the first shape formula = B2
• the second shape formula = b3
• the third shape formula = b4
• and so on for all the items in the list

but the list can be anywhere on the worksheet, so i can't hardcode "b2", i think I'd need to start from activecell. The items in the list can change, which is why I'd like it a formula rather than hardcode.
Thank you!

 

[Domenic]

Do you want the formula to refer to the active cell? If so, try...

.DrawingObject.Formula = "=" & ActiveCell.Address

 

[FredMcStaire]

Do you want the formula to refer to the active cell? If so, try...

.DrawingObject.Formula = "=" & ActiveCell.Address

too easy!
Thanks for all your help on this.
Cheers

 

[Domenic]

You're very welcome, glad I could help, cheers!