用户在Excel（VBA）中向右滚动时移动形状

Question

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

我的要求是当用户向着纸张的右侧导航时，即朝向header24，header25等，我希望纸张上的两个形状向用户移动到右侧。

有人可以为此提出任何想法。

由于

Answer 1

试试这个..是的，很容易..

将此代码放在存在形状的工作表模块中。

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）是您在键盘上滚动时固定形状的位置。

但是，如果没有滚动条在巨大的工作表上工作会很烦人。所以我认为您可以使用刷新时间，将此代码放在模块中

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中的以下代码（形状所在的位置）

Private Sub Worksheet_Activate()
    Call StartTimedRefresh
End Sub

Private Sub Worksheet_Deactivate()
    Call StopTimer
End Sub

Answer 2

首先创建形状：

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

然后在工作表代码区：

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

如果您前后移动活动单元格，框将随之移动。

注意：

这只是演示代码。你还需要：

• 添加保护以防止尝试移动Shape“屏幕外”
• 根据Shape
的大小设置ActiveCell的正确偏移量