用户在Excel（VBA）中右键移动形状 [英] Moving Shapes as user scrolls right in Excel(VBA)

问题描述

我在Sheet1上有两种形状的excel工作簿，如下所示

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

我的要求是用户正在导航到纸张的右侧，即朝向标题24，标题25等等，我希望纸张上的两个形状向用户移动到右侧。

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.

谢谢

推荐答案

尝试这个..是的，它的简单..

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

坐标（2，2）是您想要的形状在您随着键盘滚动的同时固定。

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

并且Sheet1中的以下代码在$）

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

这篇关于用户在Excel（VBA）中右键移动形状的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！