Create floating shape that stays visible on top of page when scrolling

[LRATOZ]

Hi,

I have a button on top of each sheet and when clicked takes the user back to the TOC.

'Create & Position Shape
        Set Shape = Worksheet.Shapes.AddShape(msoShapeRoundedRectangle, 550, 0, 40, 20)

I've added following code so that the shape stays in the exact same position when the user irregardless of column width:

'Prevent that shape moves whilst adding/deleting or re-sizing columns
        With Shape
        .Placement = xlFreeFloating
        End With

This works great however the button is fixed on top of the page and when scrolling up and down the shape disappears.
Is there a way that I can keep the shape on top of the page irregardless the scroll position?

I don't want to use the "Freeze the first row" or floating forms technique.

I am using Excel 2016

Many thanks in advance for your help.
Cheers,

Luke

 

[Logit]

.
Paste this into a regular module :

Option Explicit


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

Paste this into ThisWorkbook Module :

Option Explicit


Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimer
End Sub


Private Sub Workbook_Open()
StartTimedRefresh
End Sub

The first macro is set for Sheet1. You'll need to paste an ActiveX CommandButton on Sheet1.

 

[Justplainj]

.
Paste this into a regular module :

Option Explicit


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

Paste this into ThisWorkbook Module :

Option Explicit


Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimer
End Sub


Private Sub Workbook_Open()
StartTimedRefresh
End Sub

The first macro is set for Sheet1. You'll need to paste an ActiveX CommandButton on Sheet1.

This is awesome. I used it for a normal Grouped shape also and works perfectly. Thanks for this.

J