Moving Shapes as user scrolls right in Excel(VBA)

Question

I have an excel workbook with two shapes on Sheet1 like below

My Requirement is when the user is navigating towards right side of sheet i.e. Towards headers24, header25 and so on ,I want the two shapes on the sheet to move towards the right side with the user.

Can someone Please suggests any ideas for this.

Thanks

Answer 1

Try this.. yep, its easy..

Place this code in the worksheet module where the shapes exist.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    With ActiveSheet.Shapes(1)

        .Left = ActiveWindow.VisibleRange(2, 2).Left
        .Top = ActiveWindow.VisibleRange(2, 2).Top

    End With

End Sub

The coordinate (2, 2) is where you want the shape to be fixed at as you scroll along with the keyboard.

But, it would be annoying to work without the scroll bar on a huge worksheet. so alternatively I think you can use refresh ontime, place this code in a Module

Private eTime
Sub ScreenRefresh()
    With ThisWorkbook.Worksheets("Sheet1").Shapes(1)
        .Left = ThisWorkbook.Windows(1).VisibleRange(2, 2).Left
        .Top = ThisWorkbook.Windows(1).VisibleRange(2, 2).Top
    End With
End Sub

Sub StartTimedRefresh()
    Call ScreenRefresh
    eTime = Now + TimeValue("00:00:01")
    Application.OnTime eTime, "StartTimedRefresh"
End Sub

Sub StopTimer()
    Application.OnTime eTime, "StartTimedRefresh", , False
End Sub

And the following code in Sheet1 (where the shapes are in)

Private Sub Worksheet_Activate()
    Call StartTimedRefresh
End Sub

Private Sub Worksheet_Deactivate()
    Call StopTimer
End Sub

Answer 2

First create the shape:

Sub Creator()
    Dim shp As Shape

    Set shp = ActiveSheet.Shapes.AddShape(1, 100, 10, 60, 60)
    shp.TextFrame.Characters.Text = "I will follow"
    shp.Name = "MyButton"
End Sub

Then in the worksheet code area:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim sh As Shape, r As Range
    Set sh = ActiveSheet.Shapes("MyButton")
    Set r = ActiveCell
    sh.Top = r.Offset(-1, -2).Top
    sh.Left = r.Offset(-1, -2).Left
End Sub

If you move the active cell back and forth, the box will move with it.

Note:

This is only demo code. You still need to:

• add protection to prevent trying to move the Shape "off-screen"
• setting the proper offsets from ActiveCell based on the size of the Shape