0

I was asked to continu a code on VBA Excel on the following code :

Sub Ajout_45()
   Ajout (45)
End Sub

Sub Ajout_60()
  Ajout (60)
End Sub

Sub Ajout(diametre)
Dim nomforme As String
Dim basenom As String
basenom = "Forme_"

If (diametre = 45) Then
nomforme = basenom + "45"
ElseIf (diametre = 60) Then
nomforme = basenom + "60"
End If

ActiveSheet.Shapes(nomforme).Copy
Application.Wait (Now + TimeValue("0:00:01"))
ActiveSheet.Paste
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 204, 153)
Selection.ShapeRange.Name = compt
compt = compt + 1
Selection.OnAction = "Etat"

End Sub

This is my first time using VBA so I'm trying to understand the code. What I understand basically is it creates a shape based on a shape already existing. It copy and paste it. Then fill the new shape color with RGB given. Then give a name to the new shape. Then call on click the macro Etat. If I miss something or I am wrong somewhere please let me know.

My second question is why if comment the line Selection.OnAction = "Etat" every new shape created keep as macro creating new shape.

Many thanks in advance for any helpers!

Lyess2b
  • 35
  • 2
  • 7

1 Answers1

0

The Shape.OnAction Property is the name of the Macro that is called when you Click on the button.

So, this macro creates a new shape, colours it in, and tells it "When someone clicks on you, run the macro Etat"

I would, however, recommend you try to avoid using Select in your code. Using Shape.Duplicate and a With constructor will be tidier and safer:

Sub Ajout(diameter AS Long)
    Dim nomforme As String
    Dim basenom As String
    basenom = "Forme_"

    If (diametre = 45) Then
        nomforme = basenom + "45"
    ElseIf (diametre = 60) Then
        nomforme = basenom + "60"
    End If

    With ActiveSheet.Shapes(nomforme).Duplicate 'Duplicate Shape
        .Name = compt 'Set Name
        .Fill.ForeColor.RGB = RGB(255, 204, 153) 'Set Colour
        .OnAction = "Etat" 'Set the "click" macro
        compt = compt + 1 'Increase counter
    End With
End Sub

(Using ActiveSheet can also cause issues - if you always use this on a specific worksheet, try referencing that directly, e.g. Sheet1.Shapes instead of ActiveSheet.Shapes)

Chronocidal
  • 6,827
  • 1
  • 12
  • 26
  • Thank you for your swift anwser. Indeed it is cleaner to avoid select and ActiveSheet. However I don't understand when delete the call of the macro Etat it keeps duplicating a shape whenever I click on a shape. I feel like its an infinite loop.... I don't undestand the process behind this – Lyess2b Sep 21 '18 at 13:03
  • @Lyess2b The only thing I can assume there is that the Shape you are copying *already* has a Macro assigned to it, which is to create a new shape - so, the copy has this Macro assigned to. To remove it, set `OnAction = ""` – Chronocidal Sep 21 '18 at 13:05
  • I see, once a macro is assigned to a shape it sticks to it for ever ? – Lyess2b Sep 21 '18 at 13:18
  • Also how is named the new shape created ? – Lyess2b Sep 21 '18 at 13:51
  • @Lyess2b Until replaced or removed, yes. The new shape created is being given a number as a name - whatever number is stored in `compt` at that time. (`.Name = compt`) – Chronocidal Sep 21 '18 at 13:54
  • I see, thank you. By the way I want to test if this new shapes are within a range of cells. I want to use Intersect but in a If I can't write the syntax correctly. However thank you for the explanations! – Lyess2b Sep 21 '18 at 14:21
  • All shapes are held within rectangular bounding-boxes (even circles). The cell that the top-left corner of this box overlaps is `Shape.TopLeftCell` - the cell at the bottom-right corner is `Shape.BottomRightCell`. This means that the range of cells that a non-rotated shape overlaps is `Range(Shape.TopLeftCell, Shape.BottomRightCell)` - to check if it intersects `RangeToCheck` you would use something like `If Not (Intersect(RangeToCeheck, Range(Shape.TopLeftCell, Shape.BottomRightCell)) Is Nothing) Then` – Chronocidal Sep 21 '18 at 15:17