How do i make a shape float in the screen?

[bluefeather8989]

How do I make Rectangle 1 float so that it stays in the upper left corner of the screen even when scrolling up/down or left/rite?

 

[Jaafar Tribak]

Try this a bear minimum code :

In the ThisWorkbook Module:

Option Explicit

Private WithEvents cmbrsEvents As CommandBars

Private Sub Workbook_Open()
    Call HookCommandBars
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call HookCommandBars
End Sub

Private Sub HookCommandBars()
    Set cmbrsEvents = Application.CommandBars
End Sub

Private Sub cmbrsEvents_OnUpdate()
    Static n As Double
    Static m As Double
    With ActiveWindow.VisibleRange
        If n <> .Left Or .Top <> m Then
            Sheet1.Shapes("Rectangle 1").Left = .Left
            Sheet1.Shapes("Rectangle 1").Top = .Top
        End If
        n = .Left: m = .Top
    End With
End Sub

The above workaround code works but it is not smooth. A proper solution would be to subclass the workbook scrollbars or if you are more adventarous, you may try using a more elaborate solution I posted in this thread: Cool Class for making Floating Shapes !

 

[bluefeather8989]

Try this a bear minimum code :

In the ThisWorkbook Module:

Option Explicit

Private WithEvents cmbrsEvents As CommandBars

Private Sub Workbook_Open()
    Call HookCommandBars
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call HookCommandBars
End Sub

Private Sub HookCommandBars()
    Set cmbrsEvents = Application.CommandBars
End Sub

Private Sub cmbrsEvents_OnUpdate()
    Static n As Double
    Static m As Double
    With ActiveWindow.VisibleRange
        If n <> .Left Or .Top <> m Then
            Sheet1.Shapes("Rectangle 1").Left = .Left
            Sheet1.Shapes("Rectangle 1").Top = .Top
        End If
        n = .Left: m = .Top
    End With
End Sub

The above workaround code works but it is not smooth. A proper solution would be to subclass the workbook scrollbars or if you are more adventarous, you may try using a more elaborate solution I posted in this thread: Cool Class for making Floating Shapes !

this only works if the shape is selected. i need it to work without it being selected.

 

[Dan_W]

this only works if the shape is selected. i need it to work without it being selected.

If you move throughout the worksheet using arrow keys, etc., it will trigger the code and update the positioning of the shape. As you say, though, using the scrollbar does not appear to trigger the CommandBar update routine which is annoying. An alternative is the solution provided at the hyperlink at the bottom of Jaafar's reply. Subclassing is quite a precarious option and not for the faint of heart.