当用���向右滚动时在Excel(VBA)中移动形状

Question

我有一个带有两个形状的Excel工作簿，如下所示： 我的要求是，当用户向右侧导航时，即导航到headers24、header25等区域时，我希望表格上的这两个形状随着用户一起向右移动。

请问是否有任何建议？谢谢。

- Rohit Saluja

---

如果你使用箭头键、Tab键或Enter键向右/向左移动，这很容易......但如果你使用滚动条，就不那么容易了。 - Gary's Student

@Gary'sStudent: 我计划隐藏滚动条，这样用户就只能使用箭头键进行导航。 - Rohit Saluja

我稍后会发布一些示例代码（当我上电脑时）.............我们可以使用事件宏在活动单元格移动时移动形状。 - Gary's Student

@Gary'sStudent：好的，请帮忙，非常感谢。 - Rohit Saluja

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）是您希望形状固定的位置。

但是，在一个巨大的工作表上没有滚动条会很麻烦。因此，我认为您可以使用"ontime刷新"，将此代码放置在一个模块中。

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

- Rosetta

---

将形状与ActiveWindow绑定的想法不错 (+1) - Gary's Student

非常好的例子。如果您能解释解决方案的第一部分，那将会很有帮助。 - Rohit Saluja

@RohitSaluja，你遇到了什么问题？你能够运行第一个解决方案吗？如果你不确定，你必须将代码放在工作表模块（例如Sheet1）中，那里有形状存在。 - Rosetta

@Rosetta 感谢您详细的解释。我只有一个疑问，这个疑问更多是关于语法用法而不是理解逻辑。使用 ActiveSheet.Shape(1).Left，您正在尝试固定形状的左坐标，并使用 ActiveWIndow.VisibleRange(2,2) 将 Shape(1) 的位置设置为坐标 (2,2)。但我无法理解 ActiveWindow.VisibleRange(2,2).Left 的语法用法。 - Rohit Saluja

语法是 VisibleRange([RowIndex], [ColumnIndex])。比如说，如果VisibleRange.Address现在是A1:X30，那么VisibleRange(1,1)将是A1，VisibleRange(1,2)将是B1，VisibleRange(2,1)将是A2，VisibleRange(2,2)将是B2，依此类推.. - Rosetta

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

如果您移动活动单元格，这个框也会随之移动。

注意：

这仅是演示代码。您还需要：

- 添加保护以防止尝试将形状“移出屏幕” - 根据形状的大小设置相应的 ActiveCell 偏移量

- Gary's Student

---

请详细说明 sh.Top = r.Offset(-1, -2).Top 这行代码的作用是什么？ - Rohit Saluja

@RohitSaluja 它将形状的顶部移动到活动单元格左侧两个单元格和下方一个单元格的位置.....因此，如果活动单元格是F12，则参考单元格为D11。 - Gary's Student

嗯，当你执行 sh.Top 来设置形状的顶部位置时，我理解了。我也可以理解 r.offset(-1,-2)，它表示向左偏移一个单元格和两列，但是为什么要使用语法 r.offset(-1,-2).Top？ - Rohit Saluja

@rohit saluja，尝试进入VBE并在“.top”上停留时按F1。对于非常简单和明显的问题，最好自己多做点功课，不是吗？ - Patrick Lepelletier