asked on

Arrange pics on excel worksheets setup as board game

Excel worksheet is being used for an on screen board game.
Has a set of cards with instructions that have been inserted and are arrayed.
Objective. Cards need to be stacked in top left corner. And the top card placed at the bottom of the stack when clicked.
ee-example---YachtRacingStKilda2020.xlsm

Louis LIETAER

hi a good start is to create a macro to position shapes at top, left corner.

Sub shapes()

Dim shp As Shape

For Each shp In ActiveSheet.shapes
   With shp
       .Left = 1
       .Top = 1
' here try 
'      .onaction = Shape.OnAction = Shape_Click

   End With
Next

End Sub

Open in new window

Then we will need to assign another macro to shapes like this one bellow.

Sub Shape_Click()
With ActiveSheet.Shapes(Application.Caller)
    .ZOrder msoSendToBack    
End Sub

Open in new window

I have not tested yet, but this will bring you close to solution.

ASKER CERTIFIED SOLUTION

Louis LIETAER

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

gregfthompson

ASKER

Brilliant. Thanks heaps!!

Saqib Husain

I was playing with your file and tried to put a bit of animation as well. Although the question is closed I still will post it here as you could find it of value.

In my first sub I renamed all cards to Card nnn and all boats to Boat nnn to be able to keep them separate.

In the second sub I moved all Card objects to the corner in a cascade only to give it a different appearance and assigned the macro only to the Card objects.

The moving of cards has been done with a bit of animation.

Option Explicit

Sub roll_dice()
'
' roll_dice Macro
'

'
    ActiveSheet.Calculate
End Sub

Sub nameshapes()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
    Select Case shp.Type
        Case msoFormControl
        Case msoPicture
            If Left(shp.Name, 7) = "Picture" Then
                If shp.Left < 500 Then
                    shp.Name = Replace(shp.Name, "Picture", "Card")
                End If
                If shp.Top > 400 Then
                    shp.Name = Replace(shp.Name, "Picture", "Card")
                End If
                If shp.Top < 400 Then
                    shp.Name = Replace(shp.Name, "Picture", "Boat")
                End If
            End If
    End Select
Next shp
End Sub
Sub movetocorner()
Dim shp As Shape
Dim x As Single
Dim y As Single
Dim i As Single
x = 10
y = 30
i = 0.1
For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 4) = "Card" Then
    shp.Locked = msoFalse
    shp.LockAspectRatio = msoFalse
    shp.ZOrder msoBringToFront
    movecardto shp, x, y
    shp.Width = 247.6713
    shp.Height = 181.070556640625
    x = x + i
    y = y - i
    shp.OnAction = "movecard"
End If
Next shp
End Sub
Sub movecard()
    Dim shp As Shape
    Dim j As Integer
    Dim x As Single
    Dim y As Single
    Dim i As Single
    x = 10
    y = 30
    i = 0.1
    Set shp = ActiveSheet.Shapes(Application.Caller)
            For j = 0 To 180 Step 45
                movecardto shp, x, y + j
            Next j
            shp.ZOrder msoSendToBack
            For j = 180 To 0 Step -45
                movecardto shp, x, y + j
            Next j
For Each shp In ActiveSheet.Shapes
    movecardto shp, shp.Left + i, shp.Top - i
Next shp
End Sub
Sub movecardto(crd, x, y)
    crd.Left = x
    crd.Top = y
    DoEvents
End Sub

Open in new window