Problem on Excle / VBA - need to change shapes names all the time to make it work

[rafonga]

Hi guys,

I´ve written a code in VBA in which I created several shapes that represents streets, cars, then I move these shapes around according to a traffic system.
I´ve had problem using the index of each shapes (index kept rising), so I have named each one.

The problem is that each time that I simulate my code, I have to give new names to my shapes otherwise the commands won´t work.

My code first builts a cenario, then moves the shapes around. Sometimes I can simulate it more than once, and sometimes I need to rename the shapes to run it again. Its totally random!

Here is my code: The first macro generates the scenario. The second makes the cars movement. Note that there should be 6 cars (shapes) going up but they stop working for some reason unless I rename them.


Sub cenario()

Application.ScreenUpdating = True
ActiveSheet.Shapes.SelectAll
Selection.Delete

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 135, 302, 800, 30). _
Select
With Selection.ShapeRange.Fill
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.Brightness = -0.349999994
End With
Selection.ShapeRange.Line.Visible = msoFalse
Selection.Name = "1"


ActiveSheet.Shapes.AddShape(msoShapeRectangle, 135, 360, 800, 30). _
Select
With Selection.ShapeRange.Fill
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.Brightness = -0.349999994
End With
Selection.ShapeRange.Line.Visible = msoFalse
Selection.Name = "2"

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 280, 202, 30, 280). _
Select
With Selection.ShapeRange.Fill
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.Brightness = -0.349999994
End With
Selection.ShapeRange.Line.Visible = msoFalse
Selection.Name = "3"

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 500, 202, 30, 280). _
Select
With Selection.ShapeRange.Fill
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.Brightness = -0.349999994
End With
Selection.ShapeRange.Line.Visible = msoFalse
Selection.Name = "4"

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 720, 202, 30, 280). _
Select
With Selection.ShapeRange.Fill
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.Brightness = -0.349999994
End With
Selection.ShapeRange.Line.Visible = msoFalse
Selection.Name = "5"

ActiveSheet.Shapes.AddShape(msoShapeFlowchartProcess, 135, 340, 800, 3). _
Select
With Selection.ShapeRange.Fill
.ForeColor.ObjectThemeColor = msoThemeColorAccent2
.ForeColor.Brightness = -0.25
End With
Selection.Name = "6"

ActiveSheet.Shapes.AddShape(msoShapeFlowchartProcess, 135, 350, 800, 3). _
Select
With Selection.ShapeRange.Fill
.ForeColor.ObjectThemeColor = msoThemeColorAccent2
.ForeColor.Brightness = -0.25
End With
Selection.Name = "7"

ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 289.5, 285, 10, 15) _
.Select
Selection.ShapeRange.IncrementRotation 180
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.Name = "8"

ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 510, 285, 10, 15) _
.Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.Name = "9"

ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 730, 285, 10, 15) _
.Select
Selection.ShapeRange.IncrementRotation 180
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.Name = "10"

ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 289.5, 390, 10, 15) _
.Select
Selection.ShapeRange.IncrementRotation 180
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.Name = "11"

ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 510, 390, 10, 15) _
.Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.Name = "12"

ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 730, 390, 10, 15) _
.Select
Selection.ShapeRange.IncrementRotation 180
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.Name = "13"

ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 315, 310, 10, 15) _
.Select
Selection.ShapeRange.IncrementRotation -90
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.Name = "14"

ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 535, 310, 10, 15) _
.Select
Selection.ShapeRange.IncrementRotation -90
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.Name = "15"

ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 755, 310, 10, 15) _
.Select
Selection.ShapeRange.IncrementRotation -90
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.Name = "16"

ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 265, 367, 10, 15) _
.Select
Selection.ShapeRange.IncrementRotation 90
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.Name = "17"

ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 485, 367, 10, 15) _
.Select
Selection.ShapeRange.IncrementRotation 90
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.Name = "18"

ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 710, 367, 10, 15) _
.Select
Selection.ShapeRange.IncrementRotation 90
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.Name = "19"


' Primeiro semáforo VLT
ActiveSheet.Shapes.AddShape(msoShapeOval, 265, 335, 11, 11).Select
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset8
Selection.Name = "20"

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 270.5, 335, 270.5, 346). _
Select
With Selection.ShapeRange.Line
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.Visible = msoFalse
.Weight = 2.25
End With
Selection.Name = "21"

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 265.7894488189, 340.5, _
276.7894488189, 340.5).Select
With Selection.ShapeRange.Line
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.Visible = msoTrue
.Weight = 2.25
End With
Selection.Name = "22"

' Segundo semáforo VLT
ActiveSheet.Shapes.AddShape(msoShapeOval, 485, 335, 11, 11).Select
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset8
Selection.Name = "23"

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 490.5, 335, 490.5, 346). _
Select
With Selection.ShapeRange.Line
.Visible = msoFalse
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.Weight = 2.25
End With
Selection.Name = "24"

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 484.2682677165, 340.5, _
495.2682677165, 340.5).Select

With Selection.ShapeRange.Line
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.Visible = msoTrue
.Weight = 2.25
End With
Selection.Name = "25"

' Terceiro semáforo VLT
ActiveSheet.Shapes.AddShape(msoShapeOval, 705, 335, 11, 11).Select
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset8
Selection.Name = "26"

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 710.5, 335, 710.5, 346). _
Select
With Selection.ShapeRange.Line
.Visible = msoFalse
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.Weight = 2.25
End With
Selection.Name = "27"

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 703.9755905512, 340.5, _
714.9755905512, 340.5).Select
With Selection.ShapeRange.Line
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.Visible = msoTrue
.Weight = 2.25
End With
Selection.Name = "28"

' Quarto semáforo VLT
ActiveSheet.Shapes.AddShape(msoShapeOval, 315, 346, 11, 11).Select
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset8
Selection.Name = "29"

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 320.5, 346, 320.5, 357). _
Select
With Selection.ShapeRange.Line
.Visible = msoFalse
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.Weight = 2.25
End With
Selection.Name = "30"

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 314.5609448819, 351.5, _
325.5609448819, 351.5).Select
With Selection.ShapeRange.Line
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.Visible = msoTrue
.Weight = 2.25
End With
Selection.Name = "31"

' Quinto semáforo VLT
ActiveSheet.Shapes.AddShape(msoShapeOval, 535, 346, 11, 11).Select
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset8
Selection.Name = "32"


ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 540.5, 346, 540.5, 357). _
Select
With Selection.ShapeRange.Line
.Visible = msoFalse
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.Weight = 2.25
End With
Selection.Name = "33"

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 534.1951181102, 351.5, _
545.1951181102, 351.5).Select
With Selection.ShapeRange.Line
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.Visible = msoTrue
.Weight = 2.25
End With
Selection.Name = "34"

' Sexto semáforo VLT
ActiveSheet.Shapes.AddShape(msoShapeOval, 755, 346, 11, 11).Select
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset8
Selection.Name = "35"

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 760.5, 346, 760.5, 357). _
Select
With Selection.ShapeRange.Line
.Visible = msoFalse
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.Weight = 2.25
End With
Selection.Name = "36"

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 753.9024409449, 351.5, _
764.9024409449, 351.5).Select
With Selection.ShapeRange.Line
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.Visible = msoTrue
.Weight = 2.25
End With
Selection.Name = "37"


ActiveSheet.Shapes.AddShape(msoShapeRectangle, 288, 463, 15, 15). _
Select
Selection.Name = "and1"
Selection.Visible = msoTrue

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 288, 463, 15, 15). _
Select
Selection.Name = "gabi2"
Selection.Visible = msoFalse

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 288, 463, 15, 15). _
Select
Selection.Name = "gabi3"
Selection.Visible = msoFalse

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 288, 463, 15, 15). _
Select
Selection.Name = "gabi4"
Selection.Visible = msoFalse

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 288, 463, 15, 15). _
Select
Selection.Name = "gabi5"
Selection.Visible = msoFalse

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 288, 463, 15, 15). _
Select
Selection.Name = "gabi6"
Selection.Visible = msoFalse

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 508, 205, 15, 15). _
Select
Selection.Name = "v7"
Selection.Visible = msoTrue

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 508, 245, 15, 15). _
Select
Selection.Name = "v8"
Selection.Visible = msoTrue

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 508, 285, 15, 15). _
Select
Selection.Name = "v9"
Selection.Visible = msoFalse

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 508, 325, 15, 15). _
Select
Selection.Name = "v10"
Selection.Visible = msoFalse

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 508, 365, 15, 15). _
Select
Selection.Name = "48"
Selection.Visible = msoFalse

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 508, 405, 15, 15). _
Select
Selection.Name = "49"
Selection.Visible = msoFalse

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 728, 463, 15, 15). _
Select
Selection.Name = "50"
Selection.Visible = msoTrue

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 728, 463, 15, 15). _
Select
Selection.Name = "51"
Selection.Visible = msoFalse

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 728, 463, 15, 15). _
Select
Selection.Name = "52"
Selection.Visible = msoFalse

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 728, 463, 15, 15). _
Select
Selection.Name = "53"
Selection.Visible = msoFalse

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 728, 463, 15, 15). _
Select
Selection.Name = "54"
Selection.Visible = msoFalse

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 728, 463, 15, 15). _
Select
Selection.Name = "55"
Selection.Visible = msoFalse

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 140, 337, 40, 8). _
Select
Selection.Name = "veelete"
Selection.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(200, 100, 200)

End Sub

Sub verde_vertical()

ActiveSheet.Shapes("8").Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 255, 0)


ActiveSheet.Shapes("11").Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 255, 0)

i = 1
Do While 1
DoEvents

If i > 200 Then
ActiveSheet.Shapes("gabi6").Visible = msoTrue
ActiveSheet.Shapes("gabi6").Top = ActiveSheet.Shapes("gabi6").Top - 1
ActiveSheet.Shapes("gabi5").Top = ActiveSheet.Shapes("gabi5").Top - 1
ActiveSheet.Shapes("gabi4").Top = ActiveSheet.Shapes("gabi4").Top - 1
ActiveSheet.Shapes("gabi3").Top = ActiveSheet.Shapes("gabi3").Top - 1
ActiveSheet.Shapes("gabi2").Top = ActiveSheet.Shapes("gabi2").Top - 1
ElseIf i > 160 Then
ActiveSheet.Shapes("gabi5").Visible = msoTrue
ActiveSheet.Shapes("gabi5").Top = ActiveSheet.Shapes("gabi5").Top - 1
ActiveSheet.Shapes("gabi4").Top = ActiveSheet.Shapes("gabi4").Top - 1
ActiveSheet.Shapes("gabi3").Top = ActiveSheet.Shapes("gabi3").Top - 1
ActiveSheet.Shapes("gabi2").Top = ActiveSheet.Shapes("gabi2").Top - 1
ElseIf i > 120 Then
ActiveSheet.Shapes("gabi4").Visible = msoTrue
ActiveSheet.Shapes("gabi4").Top = ActiveSheet.Shapes("gabi4").Top - 1
ActiveSheet.Shapes("gabi3").Top = ActiveSheet.Shapes("gabi3").Top - 1
ActiveSheet.Shapes("gabi2").Top = ActiveSheet.Shapes("gabi2").Top - 1
ElseIf i > 80 Then
ActiveSheet.Shapes("gabi3").Visible = msoTrue
ActiveSheet.Shapes("gabi3").Top = ActiveSheet.Shapes("gabi3").Top - 1
ActiveSheet.Shapes("gabi2").Top = ActiveSheet.Shapes("gabi2").Top - 1
ElseIf i > 40 Then
ActiveSheet.Shapes("gabi2").Visible = msoTrue
ActiveSheet.Shapes("gabi2").Top = ActiveSheet.Shapes("gabi2").Top - 1
End If

ActiveSheet.Shapes("and1").Top = ActiveSheet.Shapes("and1").Top - 1

If Round(ActiveSheet.Shapes("and1").Top) = 205 Then ActiveSheet.Shapes("and1").Top = 463
If Round(ActiveSheet.Shapes("gabi2").Top) = 205 Then ActiveSheet.Shapes("gabi2").Top = 463
If Round(ActiveSheet.Shapes("gabi3").Top) = 205 Then ActiveSheet.Shapes("gabi3").Top = 463
If Round(ActiveSheet.Shapes("gabi4").Top) = 205 Then ActiveSheet.Shapes("gabi4").Top = 463
If Round(ActiveSheet.Shapes("gabi5").Top) = 205 Then ActiveSheet.Shapes("gabi5").Top = 463
If Round(ActiveSheet.Shapes("gabi6").Top) = 205 Then ActiveSheet.Shapes("gabi6").Top = 463
i = i + 1

If i > 800 Then Exit Sub

Loop

Application.ScreenUpdating = True
End Sub

 

[CalcSux78]

I wasn't able to replicate the error, but after cleaning up the code and rebuilding the second sub, all seems to be fine in Excel 2010.

Sub cenario()
Dim sh As Worksheet


Set sh = ActiveSheet
Application.ScreenUpdating = True
ActiveSheet.Shapes.SelectAll
Selection.Delete


With sh.Shapes
    'calle
    .AddShape(msoShapeRectangle, 135, 302, 800, 30).Name = "1"
    .AddShape(msoShapeRectangle, 135, 360, 800, 30).Name = "2"
    .AddShape(msoShapeRectangle, 280, 202, 30, 280).Name = "3"
    .AddShape(msoShapeRectangle, 500, 202, 30, 280).Name = "4"
    .AddShape(msoShapeRectangle, 720, 202, 30, 280).Name = "5"
    With .Range(Array("1", "2", "3", "4", "5"))
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .Fill.ForeColor.Brightness = -0.349999994
        .Line.Visible = msoFalse
    End With
    'divisor
    .AddShape(msoShapeFlowchartProcess, 135, 340, 800, 3).Name = "6"
    .AddShape(msoShapeFlowchartProcess, 135, 350, 800, 3).Name = "7"
    With .Range(Array("6", "7")).Fill.ForeColor
        .ObjectThemeColor = msoThemeColorAccent2
        .Brightness = -0.25
    End With
    .AddShape(msoShapeIsoscelesTriangle, 289.5, 285, 10, 15).Name = "8"
    .AddShape(msoShapeIsoscelesTriangle, 510, 285, 10, 15).Name = "9"
    .AddShape(msoShapeIsoscelesTriangle, 730, 285, 10, 15).Name = "10"
    .AddShape(msoShapeIsoscelesTriangle, 289.5, 390, 10, 15).Name = "11"
    .AddShape(msoShapeIsoscelesTriangle, 510, 390, 10, 15).Name = "12"
    .AddShape(msoShapeIsoscelesTriangle, 730, 390, 10, 15).Name = "13"
    .AddShape(msoShapeIsoscelesTriangle, 315, 310, 10, 15).Name = "14"
    .AddShape(msoShapeIsoscelesTriangle, 535, 310, 10, 15).Name = "15"
    .AddShape(msoShapeIsoscelesTriangle, 755, 310, 10, 15).Name = "16"
    .AddShape(msoShapeIsoscelesTriangle, 265, 367, 10, 15).Name = "17"
    .AddShape(msoShapeIsoscelesTriangle, 485, 367, 10, 15).Name = "18"
    .AddShape(msoShapeIsoscelesTriangle, 710, 367, 10, 15).Name = "19"
    With .Range(Array("8", "10", "11", "13"))
        .IncrementRotation 180
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
    End With
    With .Range(Array("9", "12"))
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
    End With
    With .Range(Array("14", "15", "16"))
        .IncrementRotation -90
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
    End With
    With .Range(Array("17", "18", "19"))
        .IncrementRotation 90
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
    End With
    ' Primeiro semáforo VLT
    With .AddShape(msoShapeOval, 265, 335, 11, 11)
        .Name = "20"
        .ShapeStyle = msoShapeStylePreset8
    End With
    .AddConnector(msoConnectorStraight, 270.5, 335, 270.5, 346).Name = "21"
    .AddConnector(msoConnectorStraight, 265.7894488189, 340.5, _
        276.7894488189, 340.5).Name = "22"
    With .Range(Array("21")).Line
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .Visible = msoFalse
        .Weight = 2.25
    End With
    With .Range(Array("22")).Line
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .Visible = msoTrue
        .Weight = 2.25
    End With
    ' Segundo semáforo VLT
    With .AddShape(msoShapeOval, 485, 335, 11, 11)
        .Name = "23"
        .ShapeStyle = msoLineStylePreset8
    End With
    With .AddConnector(msoConnectorStraight, 490.5, 335, 490.5, 346)
        .Name = "24"
        .Line.Visible = msoFalse
        .Line.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .Line.Weight = 2.25
    End With
    With .AddConnector(msoConnectorStraight, 484.2682677165, 340.5, _
            495.2682677165, 340.5)
        .Name = "25"
        With .Line
            .ForeColor.ObjectThemeColor = msoThemeColorBackground1
            .Visible = msoTrue
            .Weight = 2.25
        End With
    End With
    ' Terceiro semáforo VLT
    With .AddShape(msoShapeOval, 705, 335, 11, 11)
        .Name = "26"
        .ShapeStyle = msoShapeStylePreset8
    End With
    With .AddConnector(msoConnectorStraight, 710.5, 335, 710.5, 346)
        .Name = "27"
        With .Line
            .Visible = msoFalse
            .ForeColor.ObjectThemeColor = msoThemeColorBackground1
            .Weight = 2.25
        End With
    End With
    With .AddConnector(msoConnectorStraight, 703.9755905512, 340.5, _
            714.9755905512, 340.5)
        .Name = "28"
        With .Line
            .ForeColor.ObjectThemeColor = msoThemeColorBackground1
            .Visible = msoTrue
            .Weight = 2.25
        End With
    End With
    ' Quarto semáforo VLT
    With .AddShape(msoShapeOval, 315, 346, 11, 11)
        .Name = "29"
        .ShapeStyle = msoShapeStylePreset8
    End With
    With .AddConnector(msoConnectorStraight, 320.5, 346, 320.5, 357)
        .Name = "30"
        With .Line
            .Visible = msoFalse
            .ForeColor.ObjectThemeColor = msoThemeColorBackground1
            .Weight = 2.25
        End With
    End With
    With .AddConnector(msoConnectorStraight, 314.5609448819, 351.5, _
            325.5609448819, 351.5)
        .Name = "31"
        With .Line
            .ForeColor.ObjectThemeColor = msoThemeColorBackground1
            .Visible = msoTrue
            .Weight = 2.25
        End With
    End With
    ' Quinto semáforo VLT
    With .AddShape(msoShapeOval, 535, 346, 11, 11)
        .Name = "32"
        .ShapeStyle = msoShapeStylePreset8
    End With
    With .AddConnector(msoConnectorStraight, 540.5, 346, 540.5, 357)
        .Name = "33"
        With .Line
            .Visible = msoFalse
            .ForeColor.ObjectThemeColor = msoThemeColorBackground1
            .Weight = 2.25
        End With
    End With
    With .AddConnector(msoConnectorStraight, 534.1951181102, 351.5, _
            545.1951181102, 351.5)
        .Name = "34"
        With .Line
            .ForeColor.ObjectThemeColor = msoThemeColorBackground1
            .Visible = msoTrue
            .Weight = 2.25
        End With
    End With
    ' Sexto semáforo VLT
    With .AddShape(msoShapeOval, 755, 346, 11, 11)
        .Name = "35"
        .ShapeStyle = msoShapeStylePreset8
    End With
    With .AddConnector(msoConnectorStraight, 760.5, 346, 760.5, 357)
        .Name = "36"
        With .Line
            .Visible = msoFalse
            .ForeColor.ObjectThemeColor = msoThemeColorBackground1
            .Weight = 2.25
        End With
    End With
    With .AddConnector(msoConnectorStraight, 753.9024409449, 351.5, _
            764.9024409449, 351.5)
        .Name = "37"
        With .Line
            .ForeColor.ObjectThemeColor = msoThemeColorBackground1
            .Visible = msoTrue
            .Weight = 2.25
        End With
    End With
    .AddShape(msoShapeRectangle, 288, 463, 15, 15).Name = "and1"
    .AddShape(msoShapeRectangle, 288, 463, 15, 15).Name = "gabi2"
    .AddShape(msoShapeRectangle, 288, 463, 15, 15).Name = "gabi3"
    .AddShape(msoShapeRectangle, 288, 463, 15, 15).Name = "gabi4"
    .AddShape(msoShapeRectangle, 288, 463, 15, 15).Name = "gabi5"
    .AddShape(msoShapeRectangle, 288, 463, 15, 15).Name = "gabi6"
    .Range(Array("gabi2", "gabi3", "gabi4", "gabi5", "gabi6")).Visible = msoFalse
    .AddShape(msoShapeRectangle, 508, 205, 15, 15).Name = "v7"
    .AddShape(msoShapeRectangle, 508, 245, 15, 15).Name = "v8"
    .AddShape(msoShapeRectangle, 508, 285, 15, 15).Name = "v9"
    .AddShape(msoShapeRectangle, 508, 325, 15, 15).Name = "v10"
    .AddShape(msoShapeRectangle, 508, 365, 15, 15).Name = "48"
    .AddShape(msoShapeRectangle, 508, 405, 15, 15).Name = "49"
    .Range(Array("9", "v10", "48", "49")).Visible = msoFalse
    .AddShape(msoShapeRectangle, 728, 463, 15, 15).Name = "50"
    
    .AddShape(msoShapeRectangle, 728, 463, 15, 15).Name = "51"
    .AddShape(msoShapeRectangle, 728, 463, 15, 15).Name = "52"
    .AddShape(msoShapeRectangle, 728, 463, 15, 15).Name = "53"
    .AddShape(msoShapeRectangle, 728, 463, 15, 15).Name = "54"
    .AddShape(msoShapeRectangle, 728, 463, 15, 15).Name = "55"
    .Range(Array("51", "52", "53", "54", "55")).Visible = msoFalse
    With .AddShape(msoShapeRectangle, 140, 337, 40, 8)
        .Name = "veelete"
        .Fill.ForeColor.RGB = RGB(200, 100, 200)
    End With
End With
End Sub

Sub verde_vertical_V2()
Dim i&
Dim shp As Shape

ActiveSheet.Shapes.Range(Array("8", "11")).Fill.ForeColor.RGB = RGB(0, 255, 0)

i = 1
Do
DoEvents
For Each shp In ActiveSheet.Shapes.Range(Array("and1", "gabi2", "gabi3", _
                "gabi4", "gabi5", "gabi6"))
    Select Case i
        Case 40
            ActiveSheet.Shapes("gabi2").Visible = msoTrue
        Case 80
            ActiveSheet.Shapes("gabi3").Visible = msoTrue
        Case 120
            ActiveSheet.Shapes("gabi4").Visible = msoTrue
        Case 160
            ActiveSheet.Shapes("gabi5").Visible = msoTrue
        Case 200
            ActiveSheet.Shapes("gabi6").Visible = msoTrue
    End Select
    If shp.Visible = msoTrue Then
        If shp.Top = 206 Then
            shp.Top = 463
            Debug.Print i
        Else
            shp.Top = shp.Top - 1
        End If
    End If
Next shp
i = i + 1
Loop Until i > 800
Application.ScreenUpdating = True

End Sub

 

[rafonga]

Hi CalcSux78, thanks for cleaning up my code, I'm still learning VBA.

When I tried your code here the following happens:

1. I runned it by pressing "Play" on developer window : only the first block moved

2. I runned it using F8 (debug) : five first blocks moved, but last one kept still

Any idea on what's happening ?
The same thing ocurred for my first code. I then changed block names, it sometimes works, but them suddenly it stops working...

 

[rafonga]

I don't think it is a matter of code because both of our codes should work.
I thought of something related to memory, or something else...

 

[CalcSux78]

I think you're on the right track.. A large portion of the shapes are static. What about creating an image file to use as your background and modify sub verde_vertical_V2 to handle creation and movement of any shapes that would need to change?