Inserting/deleting shapes via macro

snowboy001

Board Regular
Joined
Dec 5, 2009
Messages
100
Is there a way to insert and delete shapes using macro coding? If so, does anyone have an example of this kind of code.
 

Some videos you may like

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

wesimmo

Board Regular
Joined
Nov 23, 2005
Messages
149
This may be of use to you in terms of looking at the syntax etc.

I basically had the 4 shapes that i wanted to use set up on the sheet.

I derived which shape i needed, which colour i wanted it to be, what text i wanted in it and then where it needed to be place on the sheet (using named ranges).

Once i had that i copied the appropriate shape, changed the properties as required and then pasted it to where i needed it to be.

The code is a bit rubbish and not annotated, apologies for that, but it did work.

Code:
Sub Map_Stakeholders()

Dim wsName, RAG, Influence, Support, wsRange, wsGroup, wsOval, wsText As String
Dim wsColourR, wsColourB, wsColourG, wsRow, wsIncrement As Integer


Application.ScreenUpdating = False


Sheets("Stakeholder Analysis").Select
Range("b8").Select

wsRow = Selection.End(xlDown).Row

Do

If ActiveCell.Value = "" Then
    
    Exit Sub

End If

wsName = ActiveCell.Value
wsRAG = ActiveCell(1, 10).Value
wsInfluence = ActiveCell(1, 7).Value
wsSupport = ActiveCell(1, 6).Value

Select Case wsRAG

    Case "R"

        wsColourR = 255
        wsColourG = 0
        wsColourB = 0

    Case "A"

        wsColourR = 255
        wsColourG = 102
        wsColourB = 0

    Case "G"
        
        wsColourR = 0
        wsColourG = 255
        wsColourB = 0
        
End Select



Select Case wsInfluence

    
    Case "Influencer"
    
        wsGroup = "Inf_Group"
        wsOval = "Inf_Oval"
        wsText = "Inf_text"
        
    Case "Follower"
        
        wsGroup = "Foll_Group"
        wsOval = "Foll_Rec"
        wsText = "Foll_Text"
    
    Case "Decision Maker"
    
        wsGroup = "DM_Group"
        wsOval = "DM_Diam"
        wsText = "DM_Text"
        
    Case "Gatekeeper"
    
        wsGroup = "GK_Group"
        wsOval = "GK_Tri"
        wsText = "GK_Text"

End Select


Select Case wsSupport

    
    Case "Promoter"
    
        wsRange = "Promo"
        
    Case "Opponent"
        
        wsRange = "Oppo"
        
    Case "Supporter"
        
        wsRange = "Suppo"
        
    Case "Neutral"

        wsRange = "Neut"

End Select



Sheets("Stakeholder Map").Select

wsIncrement = Range("A6").Value
Range("A6").Value = wsIncrement + 1

ActiveSheet.Shapes(wsGroup).Ungroup

ActiveSheet.Shapes(wsText).Select
Selection.Text = wsName

ActiveSheet.Shapes(wsOval).Select
With Selection.ShapeRange(wsColourR, wsColourG, wsColourB)
End With

ActiveSheet.Shapes.Range(Array(wsOval, _
    wsText)).Group.Select

x = Selection.Name

ActiveSheet.Shapes(x).Name = wsGroup

Selection.Copy

Range(wsRange).Select

ActiveSheet.Paste

Selection.Name = wsGroup & wsIncrement


Sheets("Stakeholder Analysis").Activate

ActiveCell(2, 1).Select

Loop Until ActiveCell.Row = wsRow + 1

Sheets("Stakeholder Map").Select

y = MsgBox("ALL STAKEHOLDERS HAVE BEEN MOVED ONTO THE MAP" & vbNewLine & "PLEASE REPOSITION THEM IF REQUIRED", vbOKOnly)


End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,464
Messages
5,596,288
Members
414,052
Latest member
Dual Showman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top