Help with object shape name and colour

[victor222]

Hello everyone,


I am relatively new to vba so am struggling to find solution the problem i have. I would appreciate any assistance please.
i have written some codes to add objects to a named sheet (different shapes, each triggered by individual buttons).
I try to assign the same colour for shapes of the same type different from another shape.
I also like to insert name and number counter in form text inside the shapes.
For example i have three buttons for each shape. One click of the button for 'shape A' should appear shape A with name 'shpA1' written inside and assigned colour. Second click should appear Shape A with name 'shpA2' written inside and assigned colour etc.


Alternatively, I want a single click to appear inputbox how many of the shape i want, and to appear any number of shape i input with names written inside of each and same colour.


Apart from not been able to get my around around it. Clicking on another type of shape changes colours of previous different shape type to the current shape i click (I guess that is because i use ActiveSheet for all).


I hope i am able to explain for anyone to understand. Please let me know if i should clarify more.




I have this code for now which is not exactly what i wanted to achieve, just sharing for you to have an idea of what am doing:



Sub add_shape()
Dim Shp As Object
Dim iNumShp As Variant
Dim i As Long
Set Shp = Worksheet("Sheet1")
Shp.Shapes.AddShape msoShapeRectangle, 195, 100, 50, 20
ActiveSheet.Shapes (""). Fill.ForeColor.SchemeColor = 5
iNumShp = InputBox ("How many shapes?"), 0 to exit", "Dynamic Numbers")
If Len (iNumShp) = 0 Or iNumShp < 1 Then Exit Sub
Sheets(1). Select
Range(Cells(1, 1), Cells (1000, 100)). Clear
With Worksheets("Sheet1")
For i = 1 To iNumShp
.Cells(1, 2 + i ). Value = "Shp" & i
Next i
End With
End Sub




Thanks in anticipation!

[nilem]

Hi Victor222,
maybe something like this

Sub ertert()
Dim shp As Shape, i&
With Cells(Rows.Count, 1).End(xlUp)(2, 1)
.Value = .Row
i = .Value
End With

With ActiveSheet.Shapes("shpA").Duplicate
.Left = Cells(i, 2).Left
.Top = Cells(i, 2).Top
.Name = "shpA" & i
.OnAction = "Makaros"
End With
End Sub

Sub Makaros()
MsgBox ActiveSheet.Shapes(Application.Caller).Name
End Sub

[victor222]

Thank so much for you help nilem, this has given me more insight even though not exactly what i wanted. Thanks